Office関連

7-Zipで圧縮・解凍を行うVBAマクロ

7-Zip VBA」といったキーワード検索でのアクセスがありました。

恐らく「圧縮・解凍ソフト 7-Zip」を使って、ファイルの圧縮や解凍を行うマクロを探している方だろうと思います。

以前下記記事でShellを使ったZIP圧縮・解凍を行うマクロを紹介しましたが、動作はサポート外となっているため、今回改めて7-Zipを使った圧縮・解凍マクロを考えてみたいと思います。

準備する物

統合アーカイバ・プロジェクトで公開されている「7-ZIP32.DLL」を使うこともできるのですが、今回はインストール不要、EXEファイル一つで使えるコマンドライン版(7za.exe)を使用します。

上記ダウンロードページからコマンドライン版をダウンロードして、適当なフォルダに解凍します。

ただし、元のファイルが「7z」ファイルになっているため、7z形式に対応した解凍ソフトを導入していない場合は、先に7-Zip本体をインストールしておく必要があります。

VBAコード

※ 7za.exeファイルのパスは必要に応じて変更してください。

Option Explicit

Private Const SevenZipFilePath As String = "C:\7zip\7za.exe"

Public Sub ArchiveSample()
'[C:\Test\PDF]フォルダをパスワード付zip形式(AES-256)で圧縮
  ArcFileOrFolder "C:\Test\PDF", "zip", "C:\7zip", "pass", True
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Public Sub ExtractSample()
'[C:\Test\PDF.zip]ファイルを解凍
  ExtractArchive "C:\Test\PDF.zip", "C:\7zip", "pass"
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Public Sub ArcFileOrFolder(ByVal SrcPath As String, _
                           Optional ByVal ArcExtension As String = "zip", _
                           Optional ByVal DestFolderPath As String = "", _
                           Optional ByVal ArcPassWord As String = "", _
                           Optional ByVal EncMethodAES256 As Boolean = True)
'ファイル・フォルダを7-Zipで圧縮
' - SrcPath:元ファイル・フォルダ
' - ArcExtension:圧縮ファイルの拡張子
' - DestFolderPath:出力先、指定しない場合は元ファイル・フォルダと同じ場所
' - ArcPassWord:圧縮ファイルのパスワード
' - EncMethodAES256:AES-256による暗号化(zip形式のみ)

  Dim DestFilePath As String
  Dim com As String
  
  'ファイル・フォルダの存在判定
  If (IsFolder(SrcPath) = False) And (IsFile(SrcPath) = False) Then Exit Sub
  
  '圧縮ファイルの拡張子設定
  ArcExtension = LCase(ArcExtension)
  Select Case ArcExtension
    Case "zip", "7z", "tar"
    Case Else: ArcExtension = "zip"
  End Select
  
  With CreateObject("Scripting.FileSystemObject")
    If IsFolder(DestFolderPath) = False Then
      If IsFolder(SrcPath) = True Then
        DestFolderPath = SrcPath
      ElseIf IsFile(SrcPath) = True Then
        DestFolderPath = .GetFile(SrcPath).ParentFolder.Path
      End If
    End If
    DestFilePath = AddPathSeparator(DestFolderPath) & _
                     .GetBaseName(SrcPath) & "." & ArcExtension
  End With
  com = ChrW(34) & SevenZipFilePath & ChrW(34) & _
        " a " & ChrW(34) & DestFilePath & ChrW(34) & " " & ChrW(34) & SrcPath & ChrW(34)
  If Len(Trim(ArcPassWord)) > 0 Then
    com = com & " -p" & ArcPassWord
    Select Case ArcExtension
      Case "zip": If EncMethodAES256 = True Then com = com & " -mem=AES256"
    End Select
  End If
  
  'Debug.Print com '確認用
  CreateObject("WScript.Shell").Run com, 1, True
End Sub

Public Sub ExtractArchive(ByVal SrcPath As String, _
                          Optional ByVal DestFolderPath As String = "", _
                          Optional ByVal ArcPassWord As String = "")
'圧縮ファイルを7-Zipで解凍
' - SrcPath:元ファイル
' - DestFolderPath:出力先、指定しない場合は元ファイルと同じ場所
' - ArcPassWord:圧縮ファイルのパスワード

  Dim com As String
  
  'ファイルの存在判定
  If IsFile(SrcPath) = False Then Exit Sub
  
  With CreateObject("Scripting.FileSystemObject")
    '圧縮ファイルの拡張子判定
    Select Case LCase(.GetExtensionName(SrcPath))
      Case "zip", "7z", "tar"
      Case Else: Exit Sub
    End Select
    
    If IsFolder(DestFolderPath) = False Then
      DestFolderPath = .GetFile(SrcPath).ParentFolder.Path
    End If
  End With
  
  com = ChrW(34) & SevenZipFilePath & ChrW(34) & _
        " x " & ChrW(34) & SrcPath & ChrW(34) & _
        " -o" & ChrW(34) & DestFolderPath & ChrW(34) & _
        " -aoa" 'ファイル上書き
  If Len(Trim(ArcPassWord)) > 0 Then com = com & " -p" & ArcPassWord
  
  'Debug.Print com '確認用
  CreateObject("WScript.Shell").Run com, 1, True
End Sub

Private Function IsFolder(ByVal SrcPath As String) As Boolean
  IsFolder = CreateObject("Scripting.FileSystemObject").FolderExists(SrcPath)
End Function
 
Private Function IsFile(ByVal SrcPath As String) As Boolean
  IsFile = CreateObject("Scripting.FileSystemObject").FileExists(SrcPath)
End Function
 
Private Function AddPathSeparator(ByVal SrcPath As String) As String
  If Right(SrcPath, 1) <> ChrW(92) Then SrcPath = SrcPath & ChrW(92)
  AddPathSeparator = SrcPath
End Function

引数の説明はコード中に記載している通りで、パスワードや暗号化方式を指定して圧縮・解凍できるようにしています。

使用しているコマンド・スイッチ

上記マクロでは、下記のコマンドラインオプションを使用して圧縮・解凍を行っています。

  1. a:アーカイブにファイルを追加します。ファイル・フォルダ圧縮。
  2. x:パス名付きでファイルを解凍します。
  3. -p{Password}:パスワードを指定します。
  4. -m{Parameters}:圧縮方法を指定します。「em」パラメーターで暗号化方式を指定できます([-mem=AES256]でAES-256による暗号化)。
  5. -o{Directory}:出力先を指定します。
  6. -ao{a|s|t|u}:上書きモードを指定します。[-aoa]で既存ファイルをすべて上書きします。

より詳細な説明は下記ページに記載されています。

7za.exeと7z.exeの違い

通常版の7-Zipには、GUIの「7-Zip File Manager」の他にコマンドライン版の「7z.exe」ファイルが含まれています。

7z.exeは7z.dllと実行することで、File Manegerと同等の機能を呼び出すことができ、それに対し「7za.exe」は、機能が制限されますが、ファイル単体で主要な機能を実行することができます。

参考Webページ

関連記事

  1. Office関連

    選択中の図形の文字列を蛍光ペンでハイライトするPowerPointマクロ

    MSDNフォーラムに「PowerPoint 2016で、マクロで選択中…

  2. Office関連

    Word 2013のアクセス キー一覧[PDF]

    前回の記事でWord 2013のアクセス キーをまとめたものを公開しま…

  3. Office関連

    セルの行数をカウントするWordマクロ

    「ソースコードを番号行付きのテーブルに変換するWordマクロ」を実行し…

  4. Office アドイン

    office-toolboxを使って簡単にOffice アドインを作成する方法

    以前「YO OFFICE」を使ってOffice アドインのひな型を作成…

  5. アイコン一覧

    Office 365アイコン(imageMso)一覧(V)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  6. Office関連

    Office 2013の開発者用リファレンス

    「Word2013 VBA の日本語ヘルプ」でも回答していますが、Of…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP