VBScript - 圧縮フォルダー機能を使って ZIP 圧縮する（マイクロソフト非推奨）

ことりと /

2023/11/7 01:38 | 3694 文字

VBScript から zip 圧縮する方法を説明します。

Windows の標準機能（圧縮フォルダー）を使う方法です。

手順は以下の 2 ステップだけ。とても簡単です。

空の zip ファイルを作る。
空の zip ファイルに圧縮したいファイルやフォルダをコピーする。

留意事項：この方法は非推奨です

次のリンク先にあるとおり、マイクロソフトはスクリプトから zip ファイルを扱うことを推奨していません。

CopyHere メソッドから Zip ファイルを処理することはできません

ユーザー操作以外の方法で zip ファイルを取り扱うことは想定されていないから、だそうです。

もし、スクリプトから zip ファイルを扱った場合、以下の現象が発生するかもしれません。

すべてのファイルを処理せずに途中で終了することがある。
エラーが発生しているにもかかわらず、エラーを示さずに終了することがある。
ユーザーの操作を求めるダイアログが表示され、ユーザー操作があるまで中断することがある。

OS が提供する機能は用いらず、外部のライブラリを利用するほうが安全と言えそうです。

ということで、使うか使わないかは、このリスクを理解したうえで決めてください。

zip 圧縮の手順

空の zip ファイルを作る。

まず Scripting.FileSystemObject オブジェクトの CreateTextFile メソッドで、拡張子 .zip の空のファイルを作ります。

続けてこのファイルに、zip ファイルフォーマットで決められている「End of central directory record」というデータを書き込みます。

「End of central directory record」はマジックナンバーの PK、それに続く ENQ 、 ACK 、18個の NUL です。

（"PK" & Chr(5) & Chr(6) & String(18, Chr(0)) の部分がそうです）

「End of central directory record」を書き込むことで、 Windows のエクスプローラーから作った空の圧縮フォルダーと同じになります。
```
Dim zipFilePath
zipFilePath = "C:\zip_test\test.zip"

'空のZIPファイルを作る
With CreateObject("Scripting.FileSystemObject").CreateTextFile(zipFilePath, True)
    .Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
    .Close
End With
```
（参考）エクスプローラーから新規作成した圧縮フォルダーのバイナリデータは以下のとおり。
```
PS C:\tmp\zip_test> Format-Hex -Path "新しい圧縮された (ZIP) フォルダー.zip"


           パス: C:\tmp\zip_test\新しい圧縮された (ZIP) フォルダー.zip

           00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F

00000000   50 4B 05 06 00 00 00 00 00 00 00 00 00 00 00 00  PK..............
00000010   00 00 00 00 00 00                                ......
```
空の zip ファイルに圧縮したいファイルやフォルダをコピーする。

まずは Shell.Application オブジェクトの NameSpace メソッドでzipファイル（圧縮フォルダ）を取得します。

続けて CopyHere メソッドで圧縮対象を zip ファイルにコピーすることで圧縮されます。
```
Dim zipCount
With CreateObject("Shell.Application").NameSpace(zipFilePath)
    '圧縮件数を初期化（この時点では、圧縮フォルダは空なので 0 になる）
    zipCount = .Items.Count

    '圧縮対象の絶対パスを取得
    Dim path
    path = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName("C:\path\to\file_or_folder_to_compress")

    '圧縮対象を zip ファイルにコピーする（＝圧縮する）
    .CopyHere(path)
    zipCount = zipCount + 1

    '実際のZIPファイルに含まれる項目数と圧縮件数が一致するまで待つ
    Do Until .Items.Count = zipCount
      WScript.Sleep 10
    Loop
End With
```
CopyHere メソッドは非同期です。
圧縮が終わる前に処理が返ってくる可能性があります。
なので、 zip ファイルに含まれる項目数と圧縮件数が同じになるまで待つ処理を入れます。

圧縮が終わる前に Shell.Application オブジェクトが解放された場合、圧縮対象の項目が zip ファイルに追加されないため、待つ処理は必ず入れます。

CopyHere メソッドに相対パスを指定したところ、コピーが終わらず処理完了をずっと待ち続ける状態になりました。
なので GetAbsolutePathName メソッドで絶対パスを取得する処理を入れています。

関数化しておく

zip 圧縮する ZipCompress 関数を作りました。

引数1には、zipファイルのパスを指定します。
引数2には、圧縮するファイルやフォルダのパスを配列で指定します。

ファイル名の重複チェックはしていません。
zip ファイル内にすでに同名のファイルがあるとダイアログが表示されます。
（置き換えるかどうするか聞いてくるアレです）

'''
''' zip圧縮します。
'''
''' @param {string} piZipPath - zipファイルのパス
''' @param {string[]} piEntries - 圧縮するファイルやフォルダのパスの配列
'''
Sub ZipCompress (ByVal piZipPath, ByVal piEntries)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    'zipファイルのパスが指定されなければ処理を終える
    If piZipPath = "" Then
        Exit Sub
    End If

    'zipファイルのパスを絶対パスに変換
    Dim zipPath
    zipPath = fso.GetAbsolutePathName(piZipPath)

    '空のZIPファイルを作る
    With fso.CreateTextFile(zipPath, True)
        .Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
        .Close
    End With

    '圧縮対象が何も指定されなければ処理を終える
    On Error Resume Next
    Dim lastIndx
    lastIndx = UBound(piEntries)
    If Err.Number <> 0 Then
        Exit Sub
    End If
    On Error GoTo 0

    '圧縮する
    Dim zipCount
    With CreateObject("Shell.Application").NameSpace(zipPath)
        '圧縮件数を初期化（この時点では、圧縮フォルダは空なので 0 になる）
        zipCount = .Items.Count
        
        Dim i
        For i = LBound(piEntries) To lastIndx
            Do
                '圧縮対象のパスが指定されなければスキップ
                Dim entryPath
                entryPath = piEntries(i)
                
                If entryPath = "" Then
                    Exit Do
                End If
                
                '絶対パスに変換
                Dim absolutePath
                absolutePath = fso.GetAbsolutePathName(entryPath)
                
                '圧縮対象が存在しなければスキップ
                If Not fso.FileExists(absolutePath) And Not fso.FolderExists(absolutePath) Then
                    Exit Do
                End If
                
                '圧縮する
                .CopyHere(absolutePath)
                zipCount = zipCount + 1

                '実際のZIPファイルに含まれる項目数と圧縮件数が一致するまで待つ
                Do Until .Items.Count = zipCount
                    WScript.Sleep 10
                Loop
            Loop While False
        Next
    End With
    
    Set fso = Nothing
End Sub

まとめ

VBScript から Windows の圧縮フォルダー機能を使って zip 圧縮ができます。

ただし、マイクロソフトが推奨していない方法なので私的なプログラムでの利用にとどめるのが無難でしょう。

公的なプログラムでは外部ライブラリの使用を検討してください。

#プログラミング #VBScript

アカウントを作成 して、もっと沢山の記事を読みませんか？

この記事が気に入ったら ことりと さんを応援しませんか？

メッセージを添えてチップを送ることができます。

この記事にコメントをしてみませんか？

ことりと

酒とアクアリウムが最近の楽しみ。