ExcelのVBAからcmdコマンド投下と7zip実行まとめ - インフラエンジニアブログカナデ

Excel VBAで集計処理などを行なう時、必要なファイルを取り寄せたり不要なファイルをzip圧縮する度にExcelから切り替えて作業するより、ExcelのVBAだけで完結したい時って意外とありますよね？

ただ、VBAのファイルコピーだと処理が煩雑になりがちで実装が面倒だったりも。

「如何に手を抜いてVBAコードを書きたい」という方におすすめの方法をまとめました。

VBAからcmdコマンド投下

まずはコマンドプロンプトでも使えるXCOPYコマンドの投下方法から。

コマンドを半角スペースで繋げるだけなので、特にポイントはありません。

コピー元と先を変更することで柔軟に利用できると思います。

Sub ファイルコピー()

    Dim オブジェクト As Object
    Dim コマンド結果 As Integer
    Dim コマンドライン As String
    Dim コピー元フォルダパス As String
    Dim コピー先フォルダパス As String
    
    '%USERPROFILE%など、Windowsの環境変数も使える
    Set オブジェクト = CreateObject("WScript.Shell")
    コピー元フォルダパス = "%USERPROFILE%\Desktop\コピー元"
    コピー先フォルダパス = "%USERPROFILE%\Desktop\コピー先"
     
    'XCOPYのオプション
    '/S 再起処理：空の場合を除いて、ディレクトリとサブディレクトリをコピー）
    '/V ベリファイ：コピー先の各ファイルのサイズを検証）
    '/Q コピー中にファイル名を表示しない
    '/Y 上書き保存の確認メッセージを表示せず上書き
    コマンドライン = "XCOPY /S /V /Q /Y " & コピー元フォルダパス & " " & コピー先フォルダパス
    コマンド結果 = オブジェクト.Run(Command:="%ComSpec% /c " & コマンドライン, WindowStyle:=0, WaitOnReturn:=True)
    
    If (コマンド結果 <> 0) Then
        MsgBox ("ファイル移動コマンド異常終了")
        End
    End If
    
    'メモリ開放
    Set オブジェクト = Nothing
    
End Sub

Sub ファイルコピー()

Dim オブジェクト As Object

Dim コマンド結果 As Integer

Dim コマンドライン As String

Dim コピー元フォルダパス As String

Dim コピー先フォルダパス As String

'%USERPROFILE%など、Windowsの環境変数も使える

Set オブジェクト = CreateObject("WScript.Shell")

コピー元フォルダパス = "%USERPROFILE%\Desktop\コピー元"

コピー先フォルダパス = "%USERPROFILE%\Desktop\コピー先"

'XCOPYのオプション

'/S 再起処理：空の場合を除いて、ディレクトリとサブディレクトリをコピー）

'/V ベリファイ：コピー先の各ファイルのサイズを検証）

'/Q コピー中にファイル名を表示しない

'/Y 上書き保存の確認メッセージを表示せず上書き

コマンドライン = "XCOPY /S /V /Q /Y " & コピー元フォルダパス & " " & コピー先フォルダパス

コマンド結果 = オブジェクト.Run(Command:="%ComSpec% /c " & コマンドライン, WindowStyle:=0, WaitOnReturn:=True)

If (コマンド結果 <> 0) Then

MsgBox ("ファイル移動コマンド異常終了")

End

End If

'メモリ開放

Set オブジェクト = Nothing

End Sub

応用して別のcmdコマンドも投下できます。

いろいろ試してみてください。

VBAから7zipコマンドで解凍する

zip圧縮や解凍で有名な7zipですが、コマンドでも利用できます。

Windows環境に併せて32bit、64bitのexeをダウンロードし、任意のフォルダに設置。（インストールしなくても利用可）

フォルダパスを切って7zip.exeを実行すればOKです。

これを応用し、VBAから実行します。

Sub セブンzipで解凍()

    Dim セブンzipコマンド As String
    Dim オブジェクト As Object
    Dim コマンド結果 As Integer
    Dim 解凍元フォルダパス As String
    Dim 解凍先フォルダパス As String

    Set オブジェクト = CreateObject("WScript.Shell")
    解凍元フォルダパス = "C:\解凍元"
    解凍先フォルダパス = "C:\解凍先"

    '7zip解凍コマンドの設定
    'x 解凍の指示
    '-y 上書き保存の確認をせず上書き
    '-o 解凍先フォルダの指定。（よくあるミス。-oとフォルダパスはスペース空けない）
    セブンzipコマンド = """C:\Program Files\7-Zip\7z.exe""" & " x -y -o" & 解凍先フォルダパス & " " & 解凍元フォルダパス & "\*.zip "

    '7zipコマンドを実行
    コマンド結果 = オブジェクト.Run(Command:="%ComSpec% /c " & セブンzipコマンド, WindowStyle:=0, WaitOnReturn:=True)

    If (コマンド結果 = 0) Then
        MsgBox "ファイルを解凍しました", vbInformation + vbOKOnly, "ファイル解凍処理"
    Else
        MsgBox "zipファイルが無い場合の処理", vbExclamation + vbOKOnly, "ファイル解凍処理"
    End If

    'メモリ開放
    Set オブジェクト = Nothing

End Sub

Sub セブンzipで解凍()

Dim セブンzipコマンド As String

Dim オブジェクト As Object

Dim コマンド結果 As Integer

Dim 解凍元フォルダパス As String

Dim 解凍先フォルダパス As String

Set オブジェクト = CreateObject("WScript.Shell")

解凍元フォルダパス = "C:\解凍元"

解凍先フォルダパス = "C:\解凍先"

'7zip解凍コマンドの設定

'x 解凍の指示

'-y 上書き保存の確認をせず上書き

'-o 解凍先フォルダの指定。（よくあるミス。-oとフォルダパスはスペース空けない）

セブンzipコマンド = """C:\Program Files\7-Zip\7z.exe""" & " x -y -o" & 解凍先フォルダパス & " " & 解凍元フォルダパス & "\*.zip "

'7zipコマンドを実行

コマンド結果 = オブジェクト.Run(Command:="%ComSpec% /c " & セブンzipコマンド, WindowStyle:=0, WaitOnReturn:=True)

If (コマンド結果 = 0) Then

MsgBox "ファイルを解凍しました", vbInformation + vbOKOnly, "ファイル解凍処理"

Else

MsgBox "zipファイルが無い場合の処理", vbExclamation + vbOKOnly, "ファイル解凍処理"

End If

'メモリ開放

Set オブジェクト = Nothing

End Sub

注意点として、Windowsだとインストールフォルダからの実行時、半角スペースが入るためダブルクォーテーションを上記のように設定する必要があります。

VBAから7zipコマンドで圧縮する

解凍とほぼ同じ方法で圧縮もできます。

Sub セブンzipで圧縮()

    Dim セブンzipコマンド As String
    Dim オブジェクト As Object
    Dim コマンド結果 As Integer
    Dim 圧縮元フォルダパス As String
    Dim 圧縮先フォルダパス As String

    Set オブジェクト = CreateObject("WScript.Shell")
    圧縮元フォルダパス = "C:\圧縮元\test"   'testフォルダが圧縮し移動され、testフォルダは削除されます
    圧縮先フォルダパス = "C:\圧縮先"

    '7zip圧縮コマンドの設定
    'a 圧縮の指示
    '-sdel 圧縮元からファイルを削除
    セブンzipコマンド = """C:\Program Files\7-Zip\7z.exe""" & " a -sdel " & 圧縮先フォルダパス & "\圧縮後ファイル名_" & Format(Now(), "yyyymmdd") & ".zip " & 圧縮元フォルダパス

    '7zipコマンドを実行
    コマンド結果 = オブジェクト.Run(Command:="%ComSpec% /c " & セブンzipコマンド, WindowStyle:=0, WaitOnReturn:=True)

    If (コマンド結果 = 0) Then
        MsgBox "ファイルを圧縮しました", vbInformation + vbOKOnly, "ファイル圧縮処理"
    Else
        MsgBox "圧縮に失敗した時の処理", vbExclamation + vbOKOnly, "ファイル圧縮処理"
    End If

    'メモリ開放
    Set オブジェクト = Nothing

End Sub

Sub セブンzipで圧縮()

Dim セブンzipコマンド As String

Dim オブジェクト As Object

Dim コマンド結果 As Integer

Dim 圧縮元フォルダパス As String

Dim 圧縮先フォルダパス As String

Set オブジェクト = CreateObject("WScript.Shell")

圧縮元フォルダパス = "C:\圧縮元\test" 'testフォルダが圧縮し移動され、testフォルダは削除されます

圧縮先フォルダパス = "C:\圧縮先"

'7zip圧縮コマンドの設定

'a 圧縮の指示

'-sdel 圧縮元からファイルを削除

セブンzipコマンド = """C:\Program Files\7-Zip\7z.exe""" & " a -sdel " & 圧縮先フォルダパス & "\圧縮後ファイル名_" & Format(Now(), "yyyymmdd") & ".zip " & 圧縮元フォルダパス

'7zipコマンドを実行

コマンド結果 = オブジェクト.Run(Command:="%ComSpec% /c " & セブンzipコマンド, WindowStyle:=0, WaitOnReturn:=True)

If (コマンド結果 = 0) Then

MsgBox "ファイルを圧縮しました", vbInformation + vbOKOnly, "ファイル圧縮処理"

Else

MsgBox "圧縮に失敗した時の処理", vbExclamation + vbOKOnly, "ファイル圧縮処理"

End If

'メモリ開放

Set オブジェクト = Nothing

End Sub

著作権について

著作権は当サイトの管理者に帰属します。

商用利用以外であれば著作権フリーでお使いいただけますが、利用時はコメントにてお知らせください。