' Backup folder using 7-Zip
Dim fso, rs, shell
' File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
' RecordSet
Set rs = CreateObject("Ador.Recordset")
' Shell
Set shell = CreateObject("WScript.Shell")
Const adVarChar = 200
Const adDate = 7
srcFolder="C:\Customer"
dstFolder="S:\Backup"
backupName="backup"
zipEXE="C:\Program Files\7-Zip\7z.exe"
' Number of files to keep
iNum = 5
' Get the date in the correct order. Why does vbscript suck so hard at date formatting?
Function getDateString()
d = ZeroPad(Day(Now()), 2)
m = ZeroPad(Month(Now()), 2)
y = Year(Now())
getDateString = y & m & d
End Function
' No printf() in VBScript it seems
Function ZeroPad(int, length)
If Len(int) < length Then
ZeroPad = Right(String(length, "0") & int, length)
End If
End Function
' Sanity checking
If Not fso.FolderExists(srcFolder) Then
Wscript.Echo "Aborted. Source folder does not exist: " & srcFolder
Wscript.Quit
End If
If Not fso.FolderExists(dstFolder) Then
Wscript.Echo "Aborted. Destination folder does not exist: " & dstFolder
Wscript.Quit
End If
If Not fso.FileExists(zipEXE) Then
Wscript.Echo "Aborted. 7-Zip program does not exist: " & zipEXE
Wscript.Quit
End If
' Create suffix of date-time
backupFileDate = getDateString() & "-" & replace(FormatDateTime(now,4),":","")
' File extension
backupFileExt = ".7z"
' Backup path without extension
backupFilePre = dstFolder & "/" & backupName & "_" & backupFileDate
' Full backup path
backupFile = backupFilePre & backupFileExt
' More sanity checking
n = 1
Do While fso.FileExists(backupFile)
' Add integeer to file, loop until it doesn't already exist
backupFile = backupFilePre & "_" & ZeroPad(n, 2) & backupFileExt
n = n + 1
Loop
'''' Zip Source Folder
' Create shell command
shCommand = """" & zipEXE & """ a -r """ & backupFile & """"
' Change to source directory
shell.CurrentDirectory = srcFolder & "/"
' Run 7-Zip in shell
shVal = shell.Run(shCommand,4,true)
' Check 7-Zip exit code
If shVal > 1 Then
Wscript.Echo "7-Zip failed with error code: " & shVal
Wscript.Quit
End If
'''' Remove old backup files
' Add required fields to recordset
With rs.Fields
.append "filepath", adVarChar, 255
.append "datelastmodified", adDate
End With
' Get folder object
set rsFolder=fso.getfolder(dstFolder)
' List folder contents to RecordSet
With rs
.open
For Each rsFile in rsFolder.files
.addnew array("filepath","datelastmodified"), array(rsFile.path,rsFile.datelastmodified)
.update
Next
End With
' Loop through folder listing recordset
i=0
If Not (rs.EOF and rs.BOF) then
' Sort by last modified, newest first
rs.Sort = "datelastmodified desc"
' Move recordset pointer to first record
rs.MoveFirst
' Loop through recordset
Do While Not rs.EOF
' get path from recordset
dFile = fso.GetFile(rs.Fields("filepath"))
' get filename from path
dFileName = fso.GetFileName(dFile)
' Check if backupName is in the filename
if InStr(1, dFileName, backupName, 1) Then
i=i+1
' wait until >iNum matches
if i > iNum Then
' Delete file, ignore errors
On Error Resume Next
fso.DeleteFile rs.Fields("filepath"), true
On Error Goto 0
End If
End If
rs.MoveNext
Loop
End If
Wscript.Echo "Backup complete at " & backupFile
