Using Excel VBA to Zip compress a file

Excel VBA - Compress a file

' Add reference to:
' 1. Microsoft Scripting Runtime
' 2. Microsoft Shell Controls and Automation
' From Tools > Reference

Option Explicit
Option Base 0

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMiliseconds As Long)

Public Sub MakeZip(zipPath As String, filePath As String)
  MakeEmptyZip zipPath
  AddFile zipPath, filePath
End Sub

Private Sub AddFile(zipPath As String, filePath As String)
  Dim sh As Shell32.Shell, fdr As Shell32.Folder, cntItems As Integer 'cnt = Count
  Set sh = CreateObject("Shell.Application")
  Set fdr = sh.Namespace(zipPath)
  cntItems = fdr.Items.Count
  fdr.CopyHere filePath, 4 + 16 + 1024
  Do
    Sleep 1000
  Loop Until cntItems < fdr.Items.Count
  Set fdr = Nothing
  Set sh = Nothing
End Sub

Private Sub MakeEmptyZip(zipPath As String)
  Dim fso As Scripting.FileSystemObject
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(zipPath) Then
    fso.DeleteFile zipPath
  End If
  fso.CreateTextFile(zipPath).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
  Set fso = Nothing
End Sub


Private Sub cmdCompress_Click()
    Dim sourcePath As String
    Dim zippedPath As String
    
    Dim sourceBaseName As String
    Dim zippedBaseName As String

    Dim sourceFullPath As String
    Dim zippedFullPath As String
        
    sourcePath = "C:\Users\Remo\Downloads\"
    zippedPath = "C:\Users\Remo\Downloads\"
    
    'sourcePath = ""
    'zippedPath = ""
    
    sourceBaseName = "DATA.MDB"
    zippedBaseName = "DATA_Compressed.zip"
    
    sourceFullPath = sourcePath + sourceBaseName
    zippedFullPath = zippedPath + zippedBase

    Call MakeZip(zippedFullPath, sourceFullPath)
    
    MsgBox ("File " + sourceBaseName + " successfully compressed into " + zippedBaseName)
End Sub

i believe this fails if items are inside folders. If the source folder contains 20 items, it's namespace will report 20, but the zip namespace will still report just 1 item-- the folder.