#If VBA7 Then
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long
    
    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#Else
    Private Declare Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long
    
    Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#End If



Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long
    'fill in the missing parameter and execute the program
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    'hProg is a "process ID under Win32. To get the process handle:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        'populate Exitcode variable
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function



'With this example you browse to the folder you want to zip
'The zip file will be saved in: DefPath = Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'You can change this folder to this if you want to use another folder
'DefPath = "C:\Users\Ron\ZipFolder"
'There is no need to change the code before you test it

Sub A_Zip_Folder_And_SubFolders_Browse_WinZip()
    Dim PathZipProgram As String, NameZipFile As String, FolderName As String
    Dim ShellStr As String, strDate As String, DefPath As String
    Dim Fld As Object, Password As String

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If

    'Create Path and name of the new zip file
    'The zip file will be saved in: DefPath = Application.DefaultFilePath
    'Normal if you have not change it this will be your Documents folder
    'You can change the folder if you want to another folder like this
    'DefPath = "C:\Users\Ron\ZipFolder"
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    'Create date/Time string, also the name of the Zip in this example
    strDate = Format(Now, "yyyy-mm-dd hh-mm-ss")

    'Set NameZipFile to the full path/name of the Zip file
    'If you want to add the word "MyZip" before the date/time use
    'NameZipFile = DefPath & "MyZip " & strDate & ".zip"
    NameZipFile = DefPath & strDate & ".zip"

    'Browse to the folder with the files that you want to Zip
    Set Fld = CreateObject("Shell.Application").BrowseForFolder(0, "Select folder to Zip", 512)
    If Not Fld Is Nothing Then
        FolderName = Fld.Self.Path
        If Right(FolderName, 1) <> "\" Then
            FolderName = FolderName & "\"
        End If

        On Error Resume Next

        'Zip all the files in the folder and subfolders, -r is Include subfolders
        'If you add -p, WinZip will store folder information for all files added,
        'not just for files from subfolders; the folder information will begin with
        'the folder specified on the command line.
        ShellStr = PathZipProgram & "Winzip32.exe -min -a -r" _
                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 & " " & Chr(34) & FolderName & "*.*" & Chr(34)


        'Note: you can replace the ShellStr with one of the example ShellStrings
        'below to test one of the examples

        'Zip the txt files in the folder and subfolders, use "*.xl*" for all excel files
        '        ShellStr = PathZipProgram & "Winzip32.exe -min -a -r" _
                 '                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 '                 & " " & Chr(34) & FolderName & "*.txt" & Chr(34)

        'Zip all files in the folder and subfolders with a name that start with Week
        '        ShellStr = PathZipProgram & "Winzip32.exe -min -a -r" _
                 '                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 '                 & " " & Chr(34) & FolderName & "Week*.*" & Chr(34)

        'Zip every file with the name ron.xls in the folder and subfolders
        '        ShellStr = PathZipProgram & "Winzip32.exe -min -a -r" _
                 '                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 '                 & " " & Chr(34) & FolderName & "ron.xls" & Chr(34)

        'Add -s like this -sYourPassWordHere if you want to add a password to the files in the zip
        '        Password = """TopSecret"""    'Do not remove the six quotes
        '        ShellStr = PathZipProgram & "Winzip32.exe -min -a -r -s" & Password _
                 '                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 '                 & " " & Chr(34) & FolderName & "*.*" & Chr(34)


        'Use ShellAndWait to run the ShellStr
        ShellAndWait ShellStr, vbHide
        If Dir(NameZipFile) <> "" Then
            MsgBox "You will find the zip file here: " & NameZipFile
        End If

    End If
End Sub


'With this example you zip a fixed folder: FolderName = "C:\Users\Ron\Desktop\TestFolder"
'Note this folder must exist, this is the only thing that you must change before you test it
'The zip file will be saved in: DefPath = Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'You can change this folder to this if you want to use another folder
'DefPath = "C:\Users\Ron\ZipFolder"

Sub B_Zip_Fixed_Folder_And_SubFolders_WinZip()
    Dim PathZipProgram As String, NameZipFile As String, FolderName As String
    Dim ShellStr As String, strDate As String, DefPath As String

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If

    'Create Path and name of the new zip file
    'The zip file will be saved in: DefPath = Application.DefaultFilePath
    'Normal if you have not change it this will be your Documents folder
    'You can change the folder if you want to another folder like this
    'DefPath = "C:\Users\Ron\ZipFolder"
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    'Create date/Time string, also the name of the Zip in this example
    strDate = Format(Now, "yyyy-mm-dd hh-mm-ss")

    'Set NameZipFile to the full path/name of the Zip file
    'If you want to add the word "MyZip" before the date/time use
    'NameZipFile = DefPath & "MyZip " & strDate & ".zip"
    NameZipFile = DefPath & strDate & ".zip"

    'Fill in the folder name that you want to zip
    FolderName = "C:\Users\Ron\Desktop\TestFolder"
    If Right(FolderName, 1) <> "\" Then
        FolderName = FolderName & "\"
    End If

    'If the folder not exist stop the macro
    If Dir(FolderName) = "" Then Exit Sub

    On Error Resume Next

    'Zip all the files in the folder and subfolders, -r is Include subfolders
    'If you add -p, WinZip will store folder information for all files added,
    'not just for files from subfolders; the folder information will begin with
    'the folder specified on the command line.
    ShellStr = PathZipProgram & "Winzip32.exe -min -a -r" _
             & " " & Chr(34) & NameZipFile & Chr(34) _
             & " " & Chr(34) & FolderName & "*.*" & Chr(34)

    'Note: you can replace the ShellStr with one of the example ShellStrings
    'in the first macro example on this page

    'Use ShellAndWait to run the ShellStr
    ShellAndWait ShellStr, vbHide
    If Dir(NameZipFile) <> "" Then
        MsgBox "You will find the zip file here: " & NameZipFile
    End If

End Sub


'With this example you browse to the folder you want and select the files that you want to zip
'Use the Ctrl key to select more then one file or select blocks of files with the shift key pressed.
'With Ctrl a you select all files in the dialog.
'The name of the zip file will be the Date/Time, you can change the NameZipFile string
'If you want to add the word "MyZip" before the date/time use
'NameZipFile = DefPath & "MyZip " & strDate & ".zip"
'The zip file will be saved in: DefPath = Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'You can change this folder to this if you want to use another folder
'DefPath = "C:\Users\Ron\ZipFolder"
'No need to change the code before you test it

Sub C_Zip_File_Or_Files_Browse_WinZip()
    Dim PathZipProgram As String, NameZipFile As String, FolderName As String
    Dim ShellStr As String, strDate As String, DefPath As String
    Dim NameList As String, sFileNameXls As String
    Dim vArr As Variant, FileNameXls As Variant, iCtr As Long

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If

    'Create Path and name of the new zip file
    'The zip file will be saved in: DefPath = Application.DefaultFilePath
    'Normal if you have not change it this will be your Documents folder
    'You can change the folder if you want to another folder like this
    'DefPath = "C:\Users\Ron\ZipFolder"
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    'Create date/Time string, also the name of the Zip in this example
    strDate = Format(Now, "yyyy-mm-dd hh-mm-ss")

    'Set NameZipFile to the full path/name of the Zip file
    'If you want to add the word "MyZip" before the date/time use
    'NameZipFile = DefPath & "MyZip " & strDate & ".zip"
    NameZipFile = DefPath & strDate & ".zip"

    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
                                              MultiSelect:=True, Title:="Select the files that you want to add to the new zip file")

    If IsArray(FileNameXls) = False Then
        'do nothing
    Else
        NameList = ""
        For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
            NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
            vArr = Split(FileNameXls(iCtr), "\")
            sFileNameXls = vArr(UBound(vArr))

            If bIsBookOpen(sFileNameXls) Then
                MsgBox "You can't zip a file that is open!" & vbLf & _
                       "Please close: " & FileNameXls(iCtr)
                Exit Sub
            End If
        Next iCtr

        On Error Resume Next

        'Zip every file you have selected with GetOpenFilename
        ShellStr = PathZipProgram & "winzip32.exe -min -a" _
                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 & " " & NameList

        'Use ShellAndWait to run the ShellStr
        ShellAndWait ShellStr, vbHide
        If Dir(NameZipFile) <> "" Then
            MsgBox "You will find the zip file here: " & NameZipFile
        End If
    End If

End Sub


'Update older files in the archive and add files that are not in the archive
'With this example you can browse to the folder and select the files that you want
'Use the Ctrl key to select more then one file or select blocks of files with the shift key pressed.
'With Ctrl a you select all files in the dialog.
'Change this code line to your path and name of the zip file :
'NameZipFile = "C:\Users\Ron\ZipFolder\ron.zip"

Sub D_Zip_File_Or_Files_Browse_Add_Update_WinZip()
'Update older files in the archive and add files that are not in the archive
'Change NameZipFile in the code to your zip file before you run the code
    Dim PathZipProgram As String, NameZipFile As String, FolderName As String
    Dim ShellStr As String, iCtr As Long
    Dim NameList As String, sFileNameXls As String
    Dim vArr As Variant, FileNameXls As Variant

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If

    'Set NameZipFile to the full path/name of the Zip file
    NameZipFile = "C:\Users\Ron\ZipFolder\ron.zip"

    'If the zip file not exist stop the macro
    If Dir(NameZipFile) = "" Then Exit Sub

    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", _
                                              MultiSelect:=True, Title:="Select the files that you want to update or add to the zip file")

    If IsArray(FileNameXls) = False Then
        'do nothing
    Else
        NameList = ""
        For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
            NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) & Chr(34)
            vArr = Split(FileNameXls(iCtr), "\")
            sFileNameXls = vArr(UBound(vArr))

            If bIsBookOpen(sFileNameXls) Then
                MsgBox "You can't zip a file that is open!" & vbLf & _
                       "Please close: " & FileNameXls(iCtr)
                Exit Sub
            End If
        Next iCtr

        On Error Resume Next

        'Zip every file you have selected with GetOpenFilename
        ShellStr = PathZipProgram & "winzip32.exe -min -u" _
                 & " " & Chr(34) & NameZipFile & Chr(34) _
                 & " " & NameList

        'Use ShellAndWait to run the ShellStr
        ShellAndWait ShellStr, vbHide
        MsgBox "You will find the zip file here: " & NameZipFile
    End If

End Sub


'With this example you zip the ActiveWorkbook
'The name of the zip file will be the name of the workbook + Date/Time
'The zip file will be saved in: DefPath = Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'You can change this folder to this if you want to use another folder
'DefPath = "C:\Users\Ron\ZipFolder"
'There is no need to change the code before you test it

Sub E_Zip_ActiveWorkbook_WinZip()
    Dim PathZipProgram As String, NameZipFile As String
    Dim ShellStr As String, strDate As String, DefPath As String
    Dim FileNameXls As String, TempFilePath As String, TempFileName As String
    Dim MyWb As Workbook, FileExtStr As String

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If

    'Build the path and name for the new xls? file
    Set MyWb = ActiveWorkbook
    If ActiveWorkbook.Path = "" Then Exit Sub

    TempFilePath = Environ$("temp") & "\"
    FileExtStr = "." & LCase(Right(MyWb.Name, _
                                   Len(MyWb.Name) - InStrRev(MyWb.Name, ".", , 1)))
    TempFileName = Left(MyWb.Name, Len(MyWb.Name) - Len(FileExtStr))

    'Use SaveCopyAs to make a copy of the file
    FileNameXls = TempFilePath & TempFileName & FileExtStr
    MyWb.SaveCopyAs FileNameXls

    'Build the path and name for the new zip file
    'The name of the zip file will be the name of the workbook + Date/Time
    'The zip file will be saved in: DefPath = Application.DefaultFilePath
    'Normal if you have not change it this will be your Documents folder.
    'You can change this folder to this if you want to use another folder
    'DefPath = "C:\Users\Ron\ZipFolder"
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If
    strDate = Format(Now, "yyyy-mm-dd hh-mm-ss")
    NameZipFile = DefPath & TempFileName & " " & strDate & ".zip"

    On Error Resume Next

    'Zip FileNameXls (copy of the ActiveWorkbook)
    ShellStr = PathZipProgram & "winzip32.exe -min -a" _
             & " " & Chr(34) & NameZipFile & Chr(34) _
             & " " & Chr(34) & FileNameXls & Chr(34)

    'Use ShellAndWait to run the ShellStr
    ShellAndWait ShellStr, vbHide
    If Dir(NameZipFile) <> "" Then
        MsgBox "You will find the zip file here: " & NameZipFile
    End If

    'Delete the file that you saved with SaveCopyAs and add to the zip file
    Kill FileNameXls

End Sub


'Note: This will only work if you use Outlook 2000-2007 as your mail program
'With this example you will send a zip file with a newly created workbook (copy of the Activeworkbook)
'The name of the zip file will be the name of the workbook + Date/Time
'After the zip file is sent the zip file and the workbook will be deleted from your hard disk
'There is no need to change the code before you test it

Sub F_Zip_Mail_ActiveWorkbook_WinZip()
    Dim PathZipProgram As String, NameZipFile As String
    Dim ShellStr As String, strDate As String
    Dim FileNameXls As String, TempFilePath As String, TempFileName As String
    Dim MyWb As Workbook, FileExtStr As String

    Dim OutApp As Object
    Dim OutMail As Object

    'Path of the Zip program
    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If

    'Build the path and name for the new xls? file
    Set MyWb = ActiveWorkbook
    If ActiveWorkbook.Path = "" Then Exit Sub

    TempFilePath = Environ$("temp") & "\"
    FileExtStr = "." & LCase(Right(MyWb.Name, _
                                   Len(MyWb.Name) - InStrRev(MyWb.Name, ".", , 1)))
    TempFileName = Left(MyWb.Name, Len(MyWb.Name) - Len(FileExtStr))

    'Use SaveCopyAs to make a copy of the file
    FileNameXls = TempFilePath & TempFileName & FileExtStr
    MyWb.SaveCopyAs FileNameXls

    'Build the path and name for the new zip file
    'The name of the zip file will be the name of the workbook + Date/Time
    strDate = Format(Now, "yyyy-mm-dd hh-mm-ss")
    NameZipFile = TempFilePath & TempFileName & " " & strDate & ".zip"

    On Error Resume Next

    'Zip FileNameXls (copy of the ActiveWorkbook)
    ShellStr = PathZipProgram & "winzip32.exe -min -a" _
             & " " & Chr(34) & NameZipFile & Chr(34) _
             & " " & Chr(34) & FileNameXls & Chr(34)

    'Use ShellAndWait to run the ShellStr
    ShellAndWait ShellStr, vbHide
    If Dir(NameZipFile) <> "" Then

        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "ron@debruin.nl"
            .CC = ""
            .BCC = ""
            .Subject = "ZipMailTest"
            .Body = "Here is the File"
            .Attachments.Add NameZipFile
            .Display    ' or use .Send
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing

        'Delete the zip file after you send the mail
        Kill NameZipFile
    End If

    'Delete the file that you saved with SaveCopyAs and add to the zip file
    Kill FileNameXls

End Sub