VBS script to create zip for file or folder in Windows using ONLY Windows' built-in capabilities

zipper.vbs

Set Args = Wscript.Arguments
source = Args(0)
target = Args(1)
tempDir = Empty

Function GetFullPath(path)
	Dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	GetFullPath = fso.GetAbsolutePathName( path )
End Function

Function GetFSElementType( ByVal path )
    With CreateObject("Scripting.FileSystemObject") 
        path = .GetAbsolutePathName( path )
        Select Case True
            Case .FileExists(path)   : GetFSElementType = 1
            Case .FolderExists(path) : GetFSElementType = 2
            Case Else                : GetFSElementType = 0
        End Select
    End With
End Function

Function IsFile( path )
    IsFile = ( GetFSElementType(path) = 1 )
End Function

Function IsFolder( path )
    IsFolder = (GetFSElementType(path) = 2 )
End Function

Function FSExists( path )
    FSExists = (GetFSElementType(path) <> 0)
End Function

Function GetNameWithoutExtension(DriveSpec)
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   GetNameWithoutExtension = fso.GetBaseName(DriveSpec)
End Function

Function createAndCopyFile(FileDriveSpec)
	Dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
    tempDir = fso.GetParentFolderName(FileDriveSpec)
	If Right(tempDir, 1) <> "\" Then
		    tempDir = tempDir & "\"
	End If
	tempDir = tempDir & fso.GetBaseName(FileDriveSpec) & "\"
	If Not fso.FolderExists(tempDir) Then
		fso.CreateFolder tempDir
	End If
	fso.CopyFile FileDriveSpec, tempDir, True
	createAndCopyFile = tempDir
End Function	 

' change relative path to absolute path
source = GetFullPath(source)
target = GetFullPath(target)
If IsFile(source) Then
' If the source is a file, then create a folder with same as filename and copy the file to the folder
	source = createAndCopyFile(source)
Else
	Wscript.Echo "Provided source file does not exist"
	Wscript.Quit
End If

' make sure source folder has \ at end
If ((IsFolder(source)) And (Right(source, 1) <> "\")) Then
    source = source & "\"
Else
	Wscript.Echo "Provided source folder does not exist"
	Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set zip = objFSO.OpenTextFile(target, 2, vbtrue)
' this is the header to designate a file as a zip
zip.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
zip.Close
Set zip = nothing

wscript.sleep 500

Set objApp = CreateObject( "Shell.Application" )
intSkipped = 0

' Loop over items within folder and use CopyHere to put them into the zip folder
For Each objItem in objApp.NameSpace( source ).Items
    If objItem.IsFolder Then
        Set objFolder = objFSO.GetFolder( objItem.Path )
        ' if this folder is empty, then skip it as it can't compress empty folders
        If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
            intSkipped = intSkipped + 1
        Else
            objApp.NameSpace( target ).CopyHere objItem
        End If
    Else
        objApp.NameSpace( target ).CopyHere objItem
    End If
Next

intSrcItems = objApp.NameSpace( source ).Items.Count
wscript.sleep 250

' delay until at least items at the top level are available
Do Until objApp.NameSpace( target ).Items.Count + intSkipped = intSrcItems
    wscript.sleep 200
Loop

'cleanup

' Delete the temporary directory created for the file
If Not IsEmpty(tempDir) Then
	tempDir = left(tempDir, len(tempDir)-1)	
	objFSO.DeleteFolder tempDir
End If

Set objItem = nothing
Set objFolder = nothing
Set objApp = nothing
Set fso = nothing
Set objFSO = nothing