【程式生活分享】自動排程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.很多~沒記住~總之不是自己空白打出來的....