zip形式で圧縮する。（7-zipのexeファイルによる圧縮）

'*****************************************************************
'　zip圧縮処理(7z.exe)
'*****************************************************************
Sub makeZip_7zExe()
    
    '7z.exeのパスを指定 （パスにスペースが含まれているため""を含めた文字列に変換）
    Dim s7zExePath As String
    s7zExePath = setDQ("C:\Program Files\7-Zip\7z.exe")
    
    '圧縮させるフォルダ、ファイルの指定（ワイルドカード使用可）
    Dim sTarget As String
    sTarget = "C:\VBA\zip_txt\*.txt"
    
    '作成するzipファイルのパス
    Dim sZipPath As String
    sZipPath = "C:\VBA\archive\ZipTest_7zExe.zip"
    
    '設定するパスワード
    Dim sPassword As String
    sPassword = "pass123"
    
    '圧縮処理
    Dim lRtn As Long
    lRtn = makeZip_7zExeCmd(s7zExePath, sZipPath, sTarget, sPassword)
     
    'パスワード設定が不要であれば下記を使用
    'lRtn = makeZip_7zExeCmd(s7zExePath, sZipPath, sTarget)
     
    If lRtn = 0 Then
        MsgBox "完了"
    Else
        MsgBox "圧縮処理でエラーが発生しました。"
    End If
    
End Sub

'*****************************************************************
'　コマンドの作成と実行
'-----------------------------------------------------------------
'　　第１引数：7zipの実行ファイル(7z.exe)のパス
'　　第２引数：作成するzipファイルのパス
'　　第３引数：圧縮させるフォルダ、ファイルのパス
'　　第４引数：設定するパスワード
'-----------------------------------------------------------------
'　　戻り値　：実行結果(0:正常終了、0以外:異常終了)
'*****************************************************************
Public Function makeZip_7zExeCmd(get7zExe As String, getZipPath As String, getTarget As String, Optional getPassword As String = "") As Long
    
    
    'コマンドの作成（基礎部分）
    Dim sCmd As String
    '設定してるパラメータは下記になります。
    '　-a      archiveにファイルを追加
    '　-tzip   archiveの種類をzipに設定
    '　-mx9    圧縮レベルを9に設定（最大）
    sCmd = get7zExe & Space(1) & "a -tzip -mx9" & Space(1)
    
    'パスワード指定があればパスワード設定ありのコマンドにする
    If getPassword <> "" Then
        'コマンドの作成（パスワード設定の追加）
        sCmd = sCmd & "-P" & getPassword & Space(1)
    End If
    
    'コマンドの作成（ファイル情報の追加）
    '指定のパスにスペースがある場合は文字列の前後を""を含めた形の文字列にする必要がある
    sCmd = sCmd & setDQ(getZipPath) & Space(1) & setDQ(getTarget)
    
    'WScript.Shellオブジェクトの作成
    Dim oWSh As Object
    Set oWSh = CreateObject("WScript.Shell")
    
    '圧縮の実行
    Dim lRtn As Long
    lRtn = oWSh.Run(Command:=sCmd, WindowStyle:=0, WaitOnReturn:=True)
    
    makeZip_7zExeCmd = lRtn

    Set oWSh = Nothing
    
End Function

'*****************************************************************
'　'ダブルクォーテーション設定
'-----------------------------------------------------------------
'　　第１引数：文字列
'-----------------------------------------------------------------
'　　戻り値　：文字列の前後に"を設定した状態の文字列
'*****************************************************************
Function setDQ(ByVal getStr As String) As String
    
    setDQ = """" & Replace(getStr, """", """""") & """"

End Function

　■実行前

　■実行結果