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