Automatisches komprimieren

Declare Function OpenProcess Lib kernel32 _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long
Declare Function GetExitCodeProcess Lib kernel32 _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
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
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function Split97(sStr As Variant, sdelim As String) As Variant
    Split97 = Evaluate({ & _
                       Application.Substitute(sStr, sdelim, ,) & })
End Function
Sub Zip_Selected_File()
    Dim PathWinZip As String, FileNameZip As String, FileName As String
    Dim ShellStr As String, strDate As String, sFileNameXls As String
    Dim vArr As Variant, FileNameXls As Variant
 
    PathWinZip = C:\Programme\WinZip\
    
    strDate = Format(Now,  dd-mm-yy h-mm-ss)
    
    FileNameXls = M:\Angebote\Bar & Lounge Windhorst.xls
 
        vArr = Split97(FileNameXls, \)
        sFileNameXls = vArr(UBound(vArr))

        FileNameZip = M:\ZipArchive\Test.zip
        ShellStr = PathWinZip & Winzip32 -min -a _
                 &   & Chr(34) & FileNameZip & Chr(34) _
                 &   & Chr(34) & FileNameXls & Chr(34)

        ShellAndWait ShellStr, vbHide
    End If
End Sub