2012年9月5日 星期三

【程式生活分享】自動排程VBS備份資料夾及定期刪過期備份檔

圖片來源:
http://www.ehow.com/how_6602127_create-file-vbscript.html
最近忙一些事,今天寫了一個很久沒碰的程式,分享給有需要的人一起使用。
VBScript做好的檔案副檔名用.vbs,Windows可以自己執行。
程式功能是這樣:
今天如果想備份C:\mydisk到C:\backup,將這程式放到windows的排定工作中,設定每天執行一次,則每天備份一次C:\mydisk資料,可在檔案內設定要存放多少天(然後自動刪除,不用人工刪除),可以將一些需要定期備份的資料做定期備份,也不用安裝任何程式,更不用擔心會被惡意程式攻擊,效能也能比較好。
另外會自動寫紀錄,看看程式有沒有定期執行。

使用的時候請先評估硬碟容量大小,以免硬碟被過大的備份檔案塞爆

PS:自動排程不會設定者,請先自行爬文,有需要我在撰寫文章。感謝大家的支持。

程式內容如下:----內複製後,貼到文字檔,副檔名改成.vbs,之後記得設定到自動排程。
------------------------------------------------------------------------------------------------------------

'可運用系統排程自動備份自己想要的資料夾

Dim objFSO, objFolder ,SourceFolder ,DestinationFolder ,backuplog ,savefolder
dim filesys, filetxt
Const ForReading = 1, ForWriting = 2, ForAppending = 8 
'=============================================================================
'定義變數區塊
'來源資料夾
SourceFolder= "c:\mydir"
'目的資料夾
DestinationFolder = "C:\backup\"
'目的資料夾(刪除過期資料夾用)
strPath = "C:\backup\"
'紀錄檔位置
backuplog = ".\backup_log.txt"
'設定要留下多少天之前的資料
Const intDaysOld = 30
'=============================================================================
Set objFSO = CreateObject("Scripting.FileSystemObject")

DestinationFolder = DestinationFolder & Year(Date) & Right("0" & Month(Date),2)  & Right("0" &Day(Date),2)
On Error Resume Next
'create folder
Set objFolder = objFSO.CreateFolder(DestinationFolder)
' copy folder
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder SourceFolder ,DestinationFolder ,TRUE
If Err.Number <> 0 Then
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile(backuplog, ForAppending, True) 
filetxt.WriteLine(  now() & "發生錯誤-->" & Err.Description)
filetxt.Close
    Err.Clear
'wscript.quit
End If
On Error Goto 0
'write log
If objFSO.FileExists(backuplog) Then
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile(backuplog, ForAppending, True) 
filetxt.WriteLine(  now() & "已執行備份。")
'Year(Date) & Right("0" & Month(Date),2) & Right("0" & Day(Date),2) &
filetxt.Close
Else
Set aFile = fso.CreateTextFile(backuplog, True)
aFile.WriteLine(now() & "已執行備份。")
End If 
Dim objFSOS : Set objFSOS = CreateObject("Scripting.FileSystemObject")
Dim objFolderS : Set objFolderS = objFSOS.GetFolder(strPath)
Dim objSubFolder
For Each objSubFolder In objFolderS.SubFolders
If objSubFolder.DateLastModified < DateValue(Now() - intDaysOld) Then
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile(backuplog, ForAppending, True) 
filetxt.WriteLine(  now() & "已刪除-->" & objSubFolder)
filetxt.Close
         objSubFolder.Delete True
    End If
Next
wscript.quit
------------------------------------------------------------------------------------------------------------
參考資料:
1.很多~沒記住~總之不是自己空白打出來的....

2 則留言:

  1. 大大你好~
    謝謝你的分享~ 我用你提供的以上資訊~ 備份了電腦檔案 是ok的~
    但是 如果來源檔 是網路磁碟~ 似乎沒有辦法~
    他會顯示"找不到路徑"
    請問這有辦法解決嘛~~
    謝謝指導~~

    回覆刪除
    回覆
    1. 挖咧~對不起~
      剛剛在寫新文章的時候才發現您的留言。
      問題2是您要的答案吧,問題1是你可能會遇到的情形。
      問題1:
      我剛好在今年1月底時寫了一隻要跨網路硬碟備份資料的視窗程式裡
      發現一個現象【存取權限】的問題。PS:那隻程式我寫完後到現在都還沒花時間去改bug><
      只要你沒登入過"指定的網路磁碟"或是本機的"帳號密碼"有經過【修改】
      都必須重新登入"指定的網路磁碟",點進去輸入帳號密碼給OS賦予VBS【存取權限】
      問題2:
      我想說你要的答案應該是這個
      您打開一個資料夾鍵入
      \\伺服器Domainname(或IP位置)\資料夾名稱(資料夾有隱藏請在尾端加$)
      如果資料夾正常打開則在設定檔內填上
      DestinationFolder = "\\伺服器Domainname(或IP位置)\資料夾名稱(資料夾有隱藏請加$)"
      應該OK
      因為我的機器就是這樣用了N個月,從這篇文到現在,除了發生過【問題1】的狀況,其餘均正常。

      刪除

如果久久沒有反應,請直接寄信
應該是我不太會用google blogger 導致有留言過久未處理><
實在深感抱歉..