Excel VBAで集計処理などを行なう時、必要なファイルを取り寄せたり不要なファイルをzip圧縮する度にExcelから切り替えて作業するより、ExcelのVBAだけで完結したい時って意外とありますよね?
ただ、VBAのファイルコピーだと処理が煩雑になりがちで実装が面倒だったりも。
「如何に手を抜いてVBAコードを書きたい」という方におすすめの方法をまとめました。
VBAからcmdコマンド投下
まずはコマンドプロンプトでも使えるXCOPYコマンドの投下方法から。
コマンドを半角スペースで繋げるだけなので、特にポイントはありません。
コピー元と先を変更することで柔軟に利用できると思います。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
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から実行します。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
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コマンドで圧縮する
解凍とほぼ同じ方法で圧縮もできます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
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 |
著作権について
著作権は当サイトの管理者に帰属します。
商用利用以外であれば著作権フリーでお使いいただけますが、利用時はコメントにてお知らせください。