Public Const AppVersion As String = "sbZip_Version_9"

Sub sbZip(ByVal vSourceFullPathName As Variant, _
  ByVal vDestinationZipFullPathName As Variant, _
  Optional bCreate As Boolean = True, _
  Optional bUse7zip 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
'      7 25-Apr-2024  Bernd  lRepeat to avoid endless loops and parameter 16 for CopyHere to avoid
'                            confirmation prompt. No error checking.
'      8 12-Sep-2024  Bernd  Use a valid empty zip template if it exists.
'                            Workaround in case the print sequence fails.
'      9 29-Dec-2024  Bernd  New option 7zip and using Logger and LibFileTools
'                            https://github.com/cristianbuse/VBA-FileTools.
Dim iFile             As Integer
Dim lItems            As Long
Dim lRepeat           As Long
Dim sLine             As String
Dim sShellCmd         As String
Dim oExec             As Object
Dim oOutput           As Object
Dim oShell            As Object
 
If GLogger Is Nothing Then Call Start_Log
If bCreate And Not IsFile(CStr(vDestinationZipFullPathName)) Then
  If Not DeleteFile(CStr(vDestinationZipFullPathName)) Then
    GLogger.warn "Could not delete file '" & vDestinationZipFullPathName & "'"
  End If
End If
If bUse7zip Then
  If IsFile("C:\Program Files\7-Zip\7z.exe") Then
    Set oShell = CreateObject("WScript.Shell")
    sShellCmd = "C:\Program Files\7-Zip\7z.exe a """ & vDestinationZipFullPathName & _
      """ """ & vSourceFullPathName & """"
    Set oExec = oShell.exec(sShellCmd)
    Set oOutput = oExec.StdOut
    Do While Not oOutput.AtEndOfStream
      sLine = oOutput.ReadLine
      If sLine <> "" Then GLogger.info "STDOUT " & sLine
    Loop
    Set oOutput = oExec.StdErr
    Do While Not oOutput.AtEndOfStream
      sLine = oOutput.ReadLine
      If sLine <> "" Then GLogger.warn "STDERR " & sLine
    Loop
    Do While oExec.Status = 0
      Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    GLogger.info vSourceFullPathName & "' zipped into '" & vDestinationZipFullPathName & "'"
  Else
    GLogger.fatal "C:\Program Files\7-Zip\7z.exe doesn't exist. Cannot zip '" & _
      vSourceFullPathName & "'"
  End If
Else
  If IsFile(GetLocalPath(ThisWorkbook.Path) & "Zip_Template.zip") Then
    'Workaround in case print sequence in Else clause does not work
    CopyFile ThisWorkbook.Path & "\Zip_Template.zip", CStr(vDestinationZipFullPathName)
    If Not IsFile(CStr(vDestinationZipFullPathName)) Then
      GLogger.warn "Could not copy template file '" & vDestinationZipFullPathName & "'"
    End If
  Else
    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, 16
    lRepeat = 0
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = _
      lItems + oShell.Namespace(vSourceFullPathName).Items.Count Or lRepeat > 5
      Application.Wait (Now + TimeValue("0:00:01"))
    lRepeat = lRepeat + 1
    Loop
    On Error GoTo 0
  Else
    oShell.Namespace(vDestinationZipFullPathName).CopyHere vSourceFullPathName, 16
    lRepeat = 0
    On Error Resume Next
    Do Until oShell.Namespace(vDestinationZipFullPathName).Items.Count = _
      lItems + 1 Or lRepeat > 3
      Application.Wait (Now + TimeValue("0:00:01"))
    lRepeat = lRepeat + 1
    Loop
    On Error GoTo 0
  End If
End If
End Sub