同僚からの依頼でzipファイル格納のVBA検討

最近社内でメールのシステムが変更になり、これまで外部への添付ファイルは自動で「①zipに格納→②パスワード生成→③別メールでパスワードを送付」ができていたのですが、手作業でzipを作成することになりました。

元々パスワード付きzipファイルをメールで送るフロー自体が色々と問題を引き起こす可能性も指摘されているので、その運用自体止めてしまえばよい気もするのですが、セキュリティ対策の主観部署がこれまで行っていたzip格納を止める判断をしなかったらしく上記のように手作業の負担が増えていました。

今回はパスワード付きzipファイルに必要なファイルを連続で圧縮するExcelVBAコードを考えてみました。

zip格納に「LhaPlus」を使用する

以前こちらの記事で紹介していますが、zip格納を安定して実行するためにLhaPlusというフリーソフトを使用します。

Windows標準の機能を呼び出してzip格納をする方法もあるのですが、公式なサポート外らしくエラーが起こるし動作が不安定でした。
LhaPlusはコマンドプロンプトから操作ができるようになっていて、それを利用することでVBAからも自動操作が可能になります。

今回考えた自動zip格納VBAツールの仕組み

今回私が考えたツールの動作と業務のフローは以下の通りです。

事前準備

①zipファイルに格納したいファイルをフォルダごとにまとめてあるフォルダに格納

②zip変換用フォルダをまとめて格納しているフォルダにツールファイルも一緒に格納（vba162_zip一括返還211219.xlsm）

詳細は以下の画像のような状態です。

ツールファイルの画面

ツールファイルは以下のような画面で作成しています。
まずzipを作成するためのフォルダ一覧を取得して、パスワードを手入力したあと、zipを作成するフローを想定しています。

ツール操作実行手順

①フォルダ取得ツールでzipに格納したいフォルダ一覧を取得
「フォルダ取得」ボタンをクリックするとツールフォルダが格納されているフォルダをB1セルに表示し、その中のサブフォルダを一覧にしてA列に取得して入力

②作成するzipファイルのパスワードを入力（B列）
パスワードが規則性のあるものにするならVBAで自動化することもできますが、今回は手入力するフローにしています。

③zip格納ボタンをクリック
サブフォルダの中のファイルが同じ名前のzipに格納され、作成されたサブフォルダ「zip格納」の中にzipファイルが作成される

今回作成したVBAコード

①フォルダ取得

Sub フォルダ取得()
    
    Dim FSO As Object, WSH As Object
    
    Dim FoldPath As String
    Dim FolderName As String
    Dim ArrFolderName() As String
    
    Dim i As Long, k As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FoldPath = ThisWorkbook.Path

    Cells(1, 2) = FoldPath
    i = 0
    FolderName = Dir(FoldPath & "\*", vbDirectory)
    Do While FolderName <> ""
        If InStr(FolderName, ".") = 0 And FolderName <> "zip格納" Then
            ReDim Preserve ArrFolderName(i)
            ArrFolderName(i) = FolderName
            Cells(i + 4, 1) = FolderName
            'Cells(i + 4, 2) = Left(Cells(i + 4, 1), 4)
            i = i + 1
        End If
    FolderName = Dir()
    Loop
    
End Sub

②zip格納

Sub サブフォルダzip格納()

    Dim Cmd As String
    Dim ArrFileName, FileName
    Dim FSO, WSH
    Dim 前FoldPath, 後FoldPath

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WSH = CreateObject("Wscript.Shell")

    WSH.CurrentDirectory = "C:\Program Files (x86)\Lhaplus"

    '前FoldPathに格納されているサブフォルダをzip格納して後FoldPathに格納
    前FoldPath = Cells(1, 2)
    後FoldPath = Cells(1, 2) & "\zip格納"

    'zip格納用のフォルダ作成
    If FSO.FolderExists(後FoldPath) = False Then
        FSO.CreateFolder 後FoldPath 'フォルダ作成
    End If

    '後で使用する対象ファイル一覧表が残っていたら削除
    If FSO.FileExists(前FoldPath & "\圧縮リスト.txt") = True Then
        FSO.DeleteFile 前FoldPath & "\圧縮リスト.txt"
    End If

    Dim i
    i = 4
    Do Until Cells(i, 1) = ""
        ArrFileName = ""
        FileName = Dir(前FoldPath & "\" & Cells(i, 1) & "\*.*", vbNormal)
        Do While FileName <> ""
            If ArrFileName <> "" Then
                ArrFileName = ArrFileName & vbCrLf & 前FoldPath & "\" & Cells(i, 1) & "\" & FileName
            Else
                ArrFileName = 前FoldPath & "\" & Cells(i, 1) & "\" & FileName
            End If
        FileName = Dir()
        Loop

        'コマンドプロンプトは文字数の上限があるので、対象ファイル一覧を「圧縮リスト.txt」に入力
        With FSO.CreateTextFile(Cells(1, 2) & "\圧縮リスト.txt")
            .WriteLine ArrFileName
            .Close
        End With

        'cells(i,2)がPassword 空欄ならパスワード設定なしでzip格納
        Cmd = "Lhaplus.exe /c:zip /n:" & 後FoldPath & "\" & Cells(i, 1) & ".zip" & " /p:" & Cells(i, 2).Text & " /l:" & Cells(1, 2) & "\圧縮リスト.txt"

        WSH.Run "%ComSpec% /c " & Cmd, 7, True

        FSO.DeleteFile Cells(1, 2) & "\圧縮リスト.txt"

    i = i + 1
    Loop

    Set FSO = Nothing
    Set WSH = Nothing

End Sub

動作確認の動画とあとがき

今回作成したコードを実行した動画は以下の通りです。

パスワード付きzipファイルをメールで送る文化には賛否両論ありますが、私の会社含めまだまだ根強く残ると思います。
自動サービスがなくなっていってしまう中手作業でこの処理を続けるのは結構つらいと思うので自動処理を考えてみました。

今回ご紹介したコードはコマンドプロンプトを起動している時間PCを使えない（キャンセルしてしまう可能性がある）ので、大量のファイルをzipに格納する場合、別のPCを使うか休憩時間前などに実行だけして休憩時間中に作成することをおすすめします。

電子書籍をタブレット・スマホで読むにはZipが便利

私はよく電子書籍をjpg形式で保管しているのですが、通常のフォルダで管理しているとスマホ、タブレットに入れるとギャラリーの中に電子書籍のデータが入ったり、また開くアプリによってページ順がばらばらになったりしていました。

「.」から始まるフォルダを作成しておけばギャラリーの中に画像が入り込むことはなくなりますが、管理が面倒になります。
（私が使っているスマホはパソコンと接続しても「.」から始まるフォルダが表示されません。）

今回は私が持っている電子書籍のデータを一括でZipフォルダに変更するために作成したVBAコードを紹介します。

LhaPlusという圧縮ソフトを使用する

「.CopyHere」というメソッドを用いたWindows標準の機能でもZipファイルは作成できますが、たくさんのファイルをZipフォルダの中に入れようとするとエラーが起こり途中で止まってしまいました。

この作成方法はWindowsのサポート対象外の機能のようでうまく動作しない場合があるとMicrosoftのページでも記載されています。

そこで圧縮のフリーソフトで有名なLhaPlusというものを使用することにしました。LhaPlusは色々なところでダウンロードできますが、私は窓の杜のページからダウンロードしました。

このLhaPlusはコマンドラインで操作できるのが特徴で、VBAと組み合わせるとかなり自由な操作が可能になります。

LhaPlusのコマンドライン

私が把握しているコマンドラインでのLhaPlusを操作するコードは以下のものです。

LhaPlusのコマンドの種類

よくあるネットで紹介されているLhaPlusの使用方法

圧縮したいファイルが複数ある場合は半角スペースを空けて記入することで一つの圧縮フォルダに複数のファイルを格納することができるようです。

このコードをそのまま使用した場合、今回の目的に対して2点問題が生じました。

1つ目は圧縮フォルダの名前が先頭のファイル名になってしまうことです。これはあとで変更しても良いので大した問題ではないですが、できれば解決しておきたい部分です。

そして2つ目が命取りの問題で、コマンドラインに出力する文字数の制限を超えることです。
電子書籍は一つのフォルダに300ページくらい入っているものがあって、全部のフルパスを指定していくとコマンドラインに出力する文字数が軽く10,000文字を超えてしまっていました。

Microsoftのサポートページによるとコマンドラインで使用できる文字数は8,191文字で、超えた分がエラーになってしまいます。

出力できない場合があるのでこのコードは使用できず他の方法を検討しました。

私がLhaPlusを操作するのに使用したコード

私がVBAに組み込んだコマンドラインのコードは以下の通りです。

「/n:」を使用して圧縮フォルダの名前を指定して、圧縮したいファイル名の一覧を記載したテキストファイルを「/l:」を用いて呼び出すことにしました。

圧縮したいファイル名の一覧はテキストファイルで、1行に1つのファイル名を記載しておくと呼び出して使用できるようになります。
私はデスクトップに「圧縮リスト.txt」というファイルを作成してする手順でVBAコードを作りました。

VBAコード紹介

私が作成したVBAコードは以下の通りです。
デスクトップの「前」の中にあるフォルダをすべて「後」というフォルダに圧縮ファイルとして出力するコードです。

圧縮ファイルの中にはダイレクトにファイルが入っていて、通常のフォルダとほとんど同じ扱いで処理できるようになっています。

VBAでコマンドラインを操作する方法はこちらの記事を参考にしてください。

デスクトップにもともと「圧縮リスト.txt」というファイルが存在していると強制的に削除してしまうので、その点だけは注意です。

指定するパスを変更すると出力前のフォルダ、出力後のフォルダなどを簡単に変更できます。

VBAでDOSのコマンドを使用する

DOSのコマンドを操作できるようになるとExcelやOutlook、Internet Explorer以外のアプリケーションでも操作できるものがあります。

私はDOSのコマンドを使用して画像の編集アプリを操作することで、たくさんある画像ファイルを一括でトリミングするのに使用しています。
今回はこのDOSのコマンドを実行するVBAで画像ファイルを編集する方法を紹介します。

紹介するVBAコードで使用するアプリケーション

IrfanViewというアプリケーションを使用します。

http://forest.watch.impress.co.jp/library/software/irfanview/でダウンロードできます。
元々たくさんのファイルを同時に処理することに優れたアプリケーションですが、これをDOSコマンドで実行することでさらに自由度が高く便利に画像編集が可能になります。

DOSコマンドを実行するVBAメソッド

DOSコマンドを実行するVBAのメソッドはRunとExecの2つがあります。

RunはDOSのウインドウを表示しないように設定したり、ウインドウを最大で表示したりすることができるのが大きなメリットです。

ExecはよりVBAとDOSを同期させるときに便利なコマンドで、出力結果をVBAで取得したりする場合にExecを使用する方が良いようです。

VBAでDOSコマンドの出力結果を取得する必要がない今回のケースのような場合、Runを用いておくと、プログラムの動作中にも他の作業ができるので便利になります。

DOSコマンドを実行するVBAのサンプルコード

VBAでコマンドラインを操作して、IrfanViewを起動し、画像ファイルの拡張子を変更し、画像ファイルをトリミングして名前を変更するサンプルコードは以下のようになります。

デスクトップにある「編集前」というフォルダにある「a.png」というファイルをトリミングして「編集後」というフォルダに「b.jpg」というファイル名と形式に変更するサンプルです。

①Execを使用する

②Run使用

DOSコマンドに指令を出す部分は変数を使うこともできますので、変数を使用してたくさんのファイルに一括で処理を実行することができます。