VBA　7-zip32.DLLを利用してZIPファイルの作成と解凍

gistfile1.vb

Option Explicit

Private Declare Function SevenZip Lib "7-zip32.DLL" ( _
    ByVal hWnd As Long, _
    ByVal szCmdLine As String, _
    ByVal szOutput As String, _
    ByVal dwSize As Long) As Long

'ZIPファイルを作成
'引数 sSrsPath：圧縮するファイルまたはフォルダーのパス
'     sZIPFile：ZIPファイルのパス
'     sPassWord：パスワード　省略可
'返り値　成功したら True、失敗したらFalse
Public Function SendToZIP( _
    sSrsPath As String, sZIPFile As String, Optional sPassWord As String = "") As Boolean
Dim sCmd As String
    sCmd = "a -tzip -mx9 -hide "
    If sPassWord <> "" Then sCmd = sCmd & "-P" & sPassWord & " "
    sCmd = sCmd & Q2(sZIPFile) & " " & Q2(sSrsPath)
    SendToZIP = DoSevenZip(sCmd) = 0
End Function

'ZIPファイルを解凍
'引数 sDstPath：解凍先のフォルダーのパス
'     sZIPFile：ZIPファイルのパス
'     sPassWord：パスワード　省略可
'返り値　成功したら True、失敗したらFalse
Public Function ExtractZIP( _
    sDstPath As String, sZIPFile As String, Optional sPassWord As String = "") As Boolean
Dim sCmd As String
    sCmd = "X -hide -aoa "
    If sPassWord <> "" Then sCmd = sCmd & "-P" & sPassWord & " "
    sCmd = sCmd & Q2(sZIPFile) & " -o" & Q2(sDstPath)
    ExtractZIP = DoSevenZip(sCmd) = 0
End Function

Private Function DoSevenZip(sCmd As String) As Long
Dim sRet As String * 1024
    DoSevenZip = SevenZip(0, sCmd, sRet, 1024)
    If DoSevenZip <> 0 Then MsgBox (Left(sRet, InStr(sRet, vbNullChar) - 1))
End Function

Public Function Q2(ByVal Text As String) As String
    Q2 = """" & Replace(Text, """", """""") & """"
End Function