SQL/Server database backups tend to compress fairly well, in my experience typically down to around 25% of the original file size. However I discovered backup data compression is only a feature of SQL/Server 2008 Enterprise Edition and it’s not a feature that inspired me to spend thousands extra on a license. I’ve attached a VBScript procedure that I wrote to automatically compress my SQL/Server backups but of course it can be used for any application where you’d like to compress the entire contents of a directory automatically.
I can’t take credit for the innovative technique of creating a ZIP header in code to make Windows create a compressed ZIP folder. That was a part of a code snippet I found elsewhere quite some time ago. For some reason the MoveHere method of Shell.NameSpace didn’t seem to remove the source file so when move mode is selected I stuck with deleting the source file afterwards. This version displays ZIP compression progress in a dialog box but you could use “ZipFile.CopyHere InFilename, 4” to disable the progress dialog box.
' VBScript to move or copy all files in a folder to a compressed ZIP file Option Explicit Const MoveMode = False Const BackupDir = "E:\DB Backups" Const TimeoutMins = 10 ' Timeout for individual file compression operation Sub MoveToZip(InFilename, OutFilename) Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject") Dim Timeout : Timeout = 0 FSO.CreateTextFile(OutFilename, true).WriteLine "PK" & Chr(5) & Chr(6) & String(18, 0) Dim Shell : Set Shell = CreateObject("Shell.Application") Dim ZipFile: Set ZipFile = Shell.NameSpace(OutFilename) ZipFile.CopyHere InFilename Do Until ZipFile.items.Count = 1 or Timeout > TimeoutMins * 600 Wscript.Sleep 100 Timeout = Timeout + 1 Loop If MoveMode and ZipFile.items.Count = 1 Then FSO.DeleteFile(InFilename) Set Shell = Nothing Set FSO = Nothing Set ZipFile = Nothing End Sub Dim FSO : set FSO = CreateObject("Scripting.FileSystemObject") Dim Folder : Set Folder = FSO.GetFolder(BackupDir) Dim Files : Set Files = Folder.Files Dim File For Each File In Files If InStr(UCase(File.Name), ".ZIP") = 0 Then MoveToZip BackupDir & "\" & File.Name, BackupDir & "\" & FSO.GetBaseName(File.Name) & ".zip" End If Next