Sub EE_ZipFile(strZipFilePath As String, strZipFileName As String, strAttach As String)
    Dim intLoop         As Long
    Dim intFileLoop     As Integer
    Dim objApp          As Object
    Dim vFileNameZip
    Dim arrFiles
 
'http://excelexperts.com/xla-routines-eeZipFile    for updates on this sub routine
    If InStr(strAttach, ",") > 0 Then
        arrFiles = Split(strAttach, ",")
    Else
        ReDim arrFiles(0)
        arrFiles(0) = strAttach
    End If
 
    If Right(strZipFilePath, 1) <> Application.PathSeparator Then
        strZipFilePath = strZipFilePath & Application.PathSeparator
    End If
 
    vFileNameZip = strZipFilePath & Replace(strZipFileName, ".zip", "") & ".zip"
 
    If IsArray(arrFiles) = False Then GoTo ExitH
 
'-------------------Create new empty Zip File-----------------
    If Len(Dir(vFileNameZip)) > 0 Then Kill vFileNameZip
    Open vFileNameZip For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
'=============================================================

    Set objApp = CreateObject("Shell.Application")
    intFileLoop = 0
 
    For intLoop = LBound(arrFiles) To UBound(arrFiles)
        'Copy file to Zip folder/file created above
        intFileLoop = intFileLoop + 1
        objApp.Namespace(vFileNameZip).CopyHere CStr(arrFiles(intLoop))
        'Wait until Compressing is complete
        On Error Resume Next
        Do Until objApp.Namespace(vFileNameZip).items.Count = intFileLoop
            Application.Wait (Now + TimeValue("0:00:01"))
        Loop
        Err.Clear: On Error GoTo 0: On Error GoTo -1
    Next intLoop
 
ExitH:
    Set objApp = Nothing
End Sub