VBA で Zip ファイルを作成する

VBA から Zip ファイルを作成する記事を検索すると「きぬあさ」さんのページが出てきます。

ZIP形式で圧縮・解凍を行うVBAマクロ
https://www.ka-net.org/blog/?p=7605

しかし、この方法はマイクロソフト非推奨というところがネック。
ということで、PowerShell を用いた方法でやってみました。

PowerShell 5.0
.Net Framework 4.5 以降
Windows 10　なら大丈夫なはず。

Sub Main()

    Dim col As Collection
    
    Set col = New Collection
    
    col.Add "e:\README.md"
    
    CompressArchive col, "E:\aaa.zip"


End Sub
'--------------------------------------------------------------
' Zip 圧縮処理
'--------------------------------------------------------------
Private Sub CompressArchive(col As Collection, strDest As String)

    Dim strCommand As String
    Dim strPath  As String
    Dim v As Variant
    Dim First As Boolean
   
    'コマンド
    strCommand = "Compress-Archive"

    strCommand = strCommand & " -Path"

    First = True
    For Each v In col
   
        If First Then
            strPath = """" & v & """"
            First = False
        Else
            strPath = strPath & ",""" & v & """"
        End If
    Next

    strCommand = strCommand & " " & strPath
   
    strCommand = strCommand & " -DestinationPath"
    strCommand = strCommand & " """ & strDest & """"

    strCommand = strCommand & " -Force"
   
   
    'PowerShell を実行する
    ExecPowerShell strCommand

End Sub

'--------------------------------------------------------------
' PowerShell 実行
'--------------------------------------------------------------
Private Sub ExecPowerShell(strCommand As String)
   
    Dim strTemp As String
    Dim strFile As String
    Dim strBuf As String
   
    With CreateObject("Scripting.FileSystemObject")
   
        strTemp = .GetSpecialFolder(2).Path
        strFile = .BuildPath(strTemp, .GetTempName & ".ps1")
    
        'テキスト出力
        With .CreateTextFile(strFile, True)
            .Write strCommand
            .Close
        End With
       
        strBuf = "powershell"
        strBuf = strBuf & " -ExecutionPolicy"
        strBuf = strBuf & " RemoteSigned"
        strBuf = strBuf & " -File"
        strBuf = strBuf & " """ & strFile & """"
    
        With CreateObject("WScript.Shell")
            Call .Run(strBuf, 0, True)
        End With
    
        .DeleteFile strFile
    
    End With

End Sub

展開は、Expand-Archive コマンド　を使えばいいのでやってみてください。

書いた後に気がついたけど記事的には「VBAからPowerShellを使う」だったかもしれないなコレ。