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

The instances of "wscript.sleep 250" are misplaced. They are intended to allow time for the system to CopyHere, and should follow each such instance immediately - or else the CopyHere actions will irregularly fail, depending on system activity and target size. Unfortunately, the system will popup an error message then, but the VBS script will not be able to detect Err.Number<>0 (because the error is not in the code, but in the system attempts to follow the code).

That being said, the final While loop is a much better way to implement these pauses, as even 250ms are not enough for all CopyHere actions - so the script will still irregularly fail when it tries to copy an object while a large object is still being handled.

Sub CopyHereAndWait(target, objItem)
intStartItems = objApp.NameSpace( target ).Items.Count
objApp.NameSpace( target ).CopyHere objItem

' Delay until at least items at the top level are available
Do Until objApp.NameSpace( target ).Items.Count >= intStartItems + 1
wscript.sleep 200
Loop
End Sub

Lines 59-73 should read:
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)
ElseIf ((IsFolder(source)) And (Right(source, 1) <> "\")) Then
' make sure source folder has \ at end
' source = source & "\" THIS IS UNNECESSARY, ALTHOUGH THE ElseIf MUST REMAIN.
Else
Wscript.Echo "Provided source does not exist"
Wscript.Quit
End If