Submitted By: Anonymous Submission

Uses Makecab.exe to store the contents of a folder in a CAB file.

Visual Basic
Option Explicit
Dim objShell
Dim objfso
Dim objFolder
Dim colFiles
Dim objFile
Dim inffile
Dim rptfile
Dim ddtfile
Dim MakeCabPath
Dim txtCabDirect
Dim outputDir
Dim inputDir

'Set the paths for where to get the files from, and where to place the final cab files.

Set objShell = WScript.CreateObject("WScript.Shell")
Set objfso=CreateObject("Scripting.FileSystemObject")

'Make sure makecab.exe exists in wither its normal location in the system32 dir, or in the current dir
If objfso.FileExists (objfso.GetSpecialFolder(1) & "\makecab.exe") Then 
 MakeCabPath=objfso.GetSpecialFolder(1) & "\makecab.exe"
ElseIf objfso.FileExists (objShell.CurrentDirectory & "\makecab.exe") Then
 MakeCabPath=WshShell.CurrentDirectory & "\makecab.exe"
 WScript.Echo "Error: Could not find Makecab.exe"
End If

'Makecab creates several output files used fo setup that are not needed if all you want is a cab file.  
'We create temp files to pass as these file names, so we can clean them up later.


'Create the ddt file used to tell makecab which files to package, and where to place the output.
'see the white paper at for more details.
'DiskDirectoryTemplate is where the packaged files will be placed2/17/2006 9:43AM
'CabinetNameTemplate is the name of the output file. Change the extension to \ .* instead of .cab for a multi volume archive. 
'Files will be named .1, .2, etc
'MaxDiskSize sets the max size of the output file. 0=no max size. If this is not 0, make sure CabinetNameTemplate (above) is set to output.*
'rather then .cab or else each time the max file size is reached a new will be created and overwrite the previous file.

Set txtCabDirect = objfso.CreateTextFile(ddtfile, True)
txtCabDirect.WriteLine ".OPTION EXPLICIT"  & vbCrLf  & _ 
".Set" & vbCrLf  & _
".set DiskDirectoryTemplate=" & outputDir & vbCrLf  & _
".Set CompressionType=MSZIP" & vbCrLf  & _
".Set MaxDiskSize=0" & VbCrLf  & _
".Set InfFileName=" & inffile & vbCrLf  & _
".Set RptFileName=" & rptfile & vbCrLf  & _
".Set Cabinet=on" & vbCrLf  & _
".Set Compress=on"
Set objFolder = objFSO.GetFolder(inputDir)
Set colFiles = objFolder.Files
For Each objFile in colFiles
    txtCabDirect.WriteLine Chr(34) & objFile.Path & Chr(34)
objShell.Run "makecab.exe /f " & ddtfile, 0, True

'clean up the tmp files


'open the output directory
objShell.Run (outputdir)