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