Email mit Zip-Anhang

Sub Verpacken()
Dim sXLPath As String, sZIPPath As String
Dim sWinZipPath As String
sXLPath = "c:\Eigene Dateien\Excel\zip.xls"
If Dir(sXLPath) = "" Then
Beep
MsgBox "Excel-Arbeitsmappe nicht gefunden!"
Exit Sub
End If
sZIPPath = Left(sXLPath, Len(sXLPath) - 3) & "zip"
sWinZipPath = "c:\Programme\PowerArchiver\Powerarc.exe"
If Dir(sWinZipPath) = "" Then
Beep
MsgBox "WinZip wurde nicht gefunden!"
Exit Sub
End If
Shell sWinZipPath & " -a " & sZIPPath & " " & sXLPath
Application.Wait Now + TimeSerial(0, 0, 2)
Dim objMessage As Object, objOutApp As Object
Set objOutApp = CreateObject("Outlook.Application")
Set objMessage = objOutApp.CreateItem(0)
With objMessage
.Attachments.Add sZIPPath
.Display
End With
Set objOutApp = Nothing
Set objMessage = Nothing
Kill sXLPath
End Sub