VBA code to zip multiple files!!!

Zip multiple files is a routine activity for file processing task. We zip multiple files to share our data to end users. We know zip files are very useful to compress files and folder which can be easily shared via email. Most of the times we need to work with multiple zip file simultaneously. We often zip multiple files once our data is processed which is a manual task usually. However, to perform end to end project automation zipping task can be automated. let's see how can we use excel macro to zip multiple programmatically.

Here is the code to zip multiple zip in desired folder:

Sub Zip_Multiple_File()
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileInputPath As String
    Dim I As Long
    Dim diaFolder As FileDialog
    Dim fileZip
    Dim zFileName As String
    
    ' Author: Dreams24
    ' Written for VBA Tricks and tips blog
    ' https://www.vbatricksntips.com
   
    ' Input box to enter zip file name
    
    zFileName = Application.InputBox("Please enter Zip file name. ", "Zip file Name", "Zip1")
    
    ' Open the file dialog to select multiple files to add in Zip
    
    Fname = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", _
                                        MultiSelect:=True)
    If IsArray(Fname) = False Then
        'Do nothing
    Else
    
        ' Open the select folder dialog to select fodler to save Zip file
        
        Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
        diaFolder.AllowMultiSelect = False
        diaFolder.Title = "Select Folder"
        diaFolder.Show
        FileInputPath = diaFolder.SelectedItems(1)
                
            If Right(FileInputPath, 1) <> "\" Then
                FileInputPath = FileInputPath & "\"
            End If
                    
                   
            fileZip = FileInputPath & zFileName & ".zip"
        
    '-------------------Create new empty Zip File-----------------
    
        If Len(Dir(fileZip)) > 0 Then Kill fileZip
     
        Open fileZip For Output As #1
     
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
     
        Close #1
     
    '-------------------------------------------------------------

            'Copy the files into the newly created Zip file
            
            Set oApp = CreateObject("Shell.Application")
    
            For I = LBound(Fname) To UBound(Fname)
                oApp.Namespace(fileZip).CopyHere Fname(I)
                Application.Wait (Now + TimeValue("0:00:02"))
    
            Next I
    
            MsgBox "You find the files here: " & fileZip
    
            On Error Resume Next
            
            Set diaFolder = Nothing
            Set oApp = Nothing
            
    End If
End Sub