Probier mal so:
Option Explicit
Sub Test()
zipFile ActiveSheet.Parent.Path & "\" & Date
End Sub
Private Sub zipFile(ByVal Path As String)
Const C_7Z_PATH = "%PROGRAMFILES%\7-Zip\7z.exe"
If Right$(Path, 1) <> "\" _
Then Path = Path & "\"
Dim strCommand As String
strCommand = """{7Z_PATH}"" a -tzip ""{SAVE_TO_ARCHIVE}"" ""{FOLDER_TO_SAVE}"""
strCommand = Replace$(strCommand, "{7Z_PATH}", C_7Z_PATH, Compare:=vbTextCompare)
strCommand = Replace$(strCommand, "{SAVE_TO_ARCHIVE}", Path & "archive_name", Compare:=vbTextCompare)
strCommand = Replace$(strCommand, "{FOLDER_TO_SAVE}", Path, Compare:=vbTextCompare)
Dim lngErrorCode As Long
With New WshShell
lngErrorCode = .Run(strCommand, WindowStyle:=1, WaitOnReturn:=1)
Select Case lngErrorCode
Case 1
Call MsgBox("File Not Found!", vbCritical)
Case 0
Call MsgBox("OK!", vbInformation)
Case Else
Call MsgBox("Oh no! Something went wrong with Wsh!", vbCritical)
End Select
End With
End Sub
|