Abstract

You can easily create a zip file via VBA.

This is the variant I like to use:

Appendix – sbZip Code

Please read my Disclaimer.

Sub sbZip(ByVal vSourceFullPathName As Variant, ByVal vDestinationZipFullPathName As Variant, Optional bCreate As Boolean = True)
'Create zip file vDestinationZipFullPathName and insert zipped file or folder vSourceFullPathName
'Version When         Who    What
'      1 24-Nov-2020  EotG   Original downloaded from https://exceloffthegrid.com/vba-cod-to-zip-unzip/
'      6 17-Dec-2020  Bernd  ByVal to enforce variants, single file feature and parameter bCreate added
Dim iFile as Integer 
Dim lItems As Long
Dim oShell As Object
 
If bCreate Or Len(Dir(vDestinationZipFullPathName)) = 0 Then
    On Error Resume Next
    Kill vDestinationZipFullPathName
    On Error GoTo 0
    iFile = FreeFile
    Open vDestinationZipFullPathName For Output As #iFile
    Print #iFile, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #iFile
End If
 
On Error Resume Next
lItems = oShell.Namespace(vDestinationZipFullPathName).Items.Count
On Error GoTo 0
 
Set oShell= CreateObject("Shell.Application")
If GetAttr(vSourceFullPathName) = vbDirectory Then
    oShell.Namespace(vDestinationZipFullPathName).CopyHere oShell.Namespace(vSourceFullPathName).Items
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = lItems + oShell.Namespace(vSourceFullPathName).Items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
Else
    oShell.Namespace(vDestinationZipFullPathName).CopyHere vSourceFullPathName
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = lItems + 1
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
End If

End Sub