この記事では、フォルダ構成そのままにサブフォルダ含めて全てのフォルダと指定した拡張子を含むファイルを別フォルダにコピーする方法についてご説明します。
【動画】フォルダ構成そのままにサブフォルダ含めて全てのフォルダと指定した拡張子を含むファイルを別フォルダにコピーする実際の動き
本題に入る前に、まずは次の動画をご覧ください。
コピー元のフォルダから、配下全てのフォルダをフォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーしています。
ただし、コピーと言っても実は「新規で同じフォルダ名を作成」しています。同じ構成でフォルダを作成するので、作成元と見た目が同じになるのでコピーと言う表現を使っています。
「新規で同じフォルダ名を作成」するにはMkDirステートメントを使ってフォルダを作成していますが、本記事ではコピーと言う表現を使って説明します。
また、コピー元のフォルダ配下にファイルが存在するか確認し、もし存在している場合は指定した拡張子のファイルかどうかを確認します。
確認した結果指定した拡張子のファイルの場合は、コピーした先のフォルダ配下にファイルをコピーしています。
(例：dll,ini,csv)
マクロ作成の流れ
存在するフォルダ全てをコピー(作成)するには、STEP.1のフォルダオブジェクトに対してSubFoldersプロパティを使いフォルダ配下のフォルダを全て取得してMkDirステートメントで作成します。
また、フォルダ配下の全てのフォルダを特定するには、再帰処理を使って繰り返し(For Eachステートメントを使用)行います。
再帰処理については「注目すべきコード①」の説明の中で触れていますのでそちらをご覧ください。
Excelファイルの例
コピー元フォルダ名を入力するセルには「folderCopyFrom」と、コピー先フォルダ名を入力するセルには「folderCopyTo」という名前を付けています。
また、拡張子を入力するセルに「extension」という名前を付けています。
なお、複数の拡張子を対象にファイルをコピーしたい場合は、拡張子の文字列をカンマでつないで入力します。
コードの例
Excelのマクロのコード(例)
Option Explicit
Private Sub btn_copyFolderFile_Click()
Dim folderCopyFrom As String 'コピー元のフォルダパス
Dim folderCopyTo As String 'コピー先のフォルダパス
Dim extStr() As String '拡張子格納用配列
'コピー元のフォルダパスを取得する
folderCopyFrom = Sheets("top").Range("folderCopyFrom").Value
'コピー先のフォルダパスを取得する
folderCopyTo = Sheets("top").Range("folderCopyTo").Value
'指定された拡張子を取得する
extStr = Split(Sheets("top").Range("extension").Value, ",")
'フォルダ名・ファイル名を取得する
Call copyFolderOnly(folderCopyFrom, folderCopyTo, extStr)
MsgBox "完了"
End Sub
Sub copyFolderOnly(folderCopyFrom As String, _
folderCopyTo As String, _
extStr() As String)
Dim cnt As Integer 'カウンタ
Dim mflder As Object '主フォルダ
Dim sflder As Object 'サブフォルダ
Dim sfile As File 'ファイル
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
'FileSystemObjectのインスタンスを生成する
Set fso = New FileSystemObject
If fso.FolderExists(folderCopyFrom) = False Then
'指定したフォルダが存在しない場合
MsgBox "存在するフォルダを指定してください"
'処理を終了する
End
End If
'指定したフォルダのパスからフォルダオブジェクトを取得する
Set mflder = fso.GetFolder(folderCopyFrom)
'パスのサブフォルダを対象にループする
For Each sflder In mflder.SubFolders
'フォルダを作成する
MkDir folderCopyTo & "\" & Replace(sflder.Path, Sheets("top").Range("folderCopyFrom").Value & "\", "")
If sflder.Files.Count > 0 Then
'フォルダ内にファイルがある場合
For Each sfile In sflder.Files
'フォルダ内のファイルの数分ループ
For cnt = 0 To UBound(extStr)
'指定された拡張の数分ループ
If fso.GetExtensionName(sfile.Path) = extStr(cnt) Then
'該当する拡張子のファイルの場合
'ファイルをコピーする
fso.CopyFile _
sfile.Path, _
folderCopyTo & "\" & Replace(sflder.Path, Sheets("top").Range("folderCopyFrom").Value & "\", "") & "\" & sfile.Name
End If
Next cnt
Next sfile
End If
'本プロシージャを再帰呼び出しする
Call copyFolderOnly(sflder.Path, folderCopyTo, extStr)
DoEvents
Next sflder
End Sub
コードの解説
注目すべきコード①
最初に見て頂きたいのは50行目から56行目と、88行目から92行目です。
'指定したフォルダのパスからフォルダオブジェクトを取得する
Set mflder = fso.GetFolder(folderCopyFrom)
'パスのサブフォルダを対象にループする
For Each sflder In mflder.SubFolders
'フォルダを作成する
MkDir folderCopyTo & "\" & Replace(sflder.Path, Sheets("top").Range("folderCopyFrom").Value & "\", "")
'自プロシージャを再帰呼び出しする
Call copyFolderOnly(sflder.Path, folderCopyTo, extStr)
DoEvents
Next sflder
50行目では、配下全てのフォルダをコピーするトップのフォルダから「まずは」フォルダオブジェクトを取得しています。
なお、トップのフォルダから配下のフォルダ内を一つ特定したら56行目で、その特定したフォルダ名と同じ名前のフォルダをMkDirステートメントでコピー先に作成します。
MkDirステートメントを実行すると、新規でフォルダが作成されます。
MkDirステートメントの引数には、作成したいフォルダをフルパスで指定します。
【コードの例】
MkDir "C:\work\test"
上記のコードは、「C:\work」の配下に「test」というフォルダを新規で作成するコードです。
上記のコードを実行すると下の画像のとおりに「test」というフォルダが作成されます。
次に88行目で自プロシージャ(copyFolderOnly)内で自プロシージャ(copyFolderOnly)を呼び出します。
Sub copyFolderOnly(folderCopyFrom As String, _
folderCopyTo As String, _
extStr() As String)
なぜ再度自プロシージャ(copyFolderOnly)を呼び出すのかというと、階層を一つずつ掘り下げて、掘り下げた先の配下にフォルダがないかを探しに行きたいからです。
例えば、「C:¥work¥work1¥work2¥work3」というフォルダが存在していて、「C:¥work」配下のフォルダ全てを、フォルダ構成そのままに別のフォルダにコピーしたいとします。
以上のフォルダの場合、欲しいフォルダは「work1」「work2」「work3」のフォルダです。
どのようにフォルダ構成そのままに別のフォルダにコピーするのか、その処理の流れとしては次のイメージです。
以上のように階層を一つ掘り下げてフォルダが見つかったら、その見つかったフォルダから続けて階層を一つ掘り下げてフォルダがないかを探しに行く…この「階層を一つ掘り下げてフォルダがないか探す」処理を繰り返すために、再度自プロシージャ(copyFolderOnly)を呼び出すというわけです。
この、プロシージャ(copyFolderOnly)内で処理が行われている途中にもかかわらず自プロシージャ(copyFolderOnly)を呼び出す処理のことを「再帰処理」と呼びます。
自プロシージャ(copyFolderOnly)は呼び出されたら、自プロシージャ(copyFolderOnly)の頭から再度処理が始まります。
再度同じプロシージャが呼び出される(再帰処理が行われる)と再度50行目で、特定したフォルダをGetFolderの引数に指定してフォルダオブジェクトを取得します。
特定したフォルダからフォルダオブジェクトを取得したら、特定したフォルダに対して再度「階層を一つ掘り下げてフォルダがないか探す」処理を繰り返します。
全てのフォルダが特定できて指定の別フォルダに対してフォルダ構成そのままにコピーできるまで再帰処理は行われます。
注目すべきコード②
次に見て頂きたいのは58行目から85行目です。
If sflder.Files.Count > 0 Then
'フォルダ内にファイルがある場合
For Each sfile In sflder.Files
'フォルダ内のファイルの数分ループ
For cnt = 0 To UBound(extStr)
'指定された拡張の数分ループ
If fso.GetExtensionName(sfile.Path) = extStr(cnt) Then
'該当する拡張子のファイルの場合
'ファイルをコピーする
fso.CopyFile _
sfile.Path, _
folderCopyTo & "\" & Replace(sflder.Path, Sheets("top").Range("folderCopyFrom").Value & "\", "") & "\" & sfile.Name
End If
Next cnt
Next sfile
End If
以上は、ファイルをコピーする処理です。
指定された拡張子だけをコピーしたいので、処理の流れは次の通りです。
STEP.1
58行目ではコピー元のフォルダ配下にファイルが存在するかを確認します。
ファイルの存在有無はFiles.Countプロパティを使い、値が0ならファイルが存在しない、0よりも大きければファイルが存在することが分かります。
なお、ここでのファイルの存在有無の確認は拡張子の判定はしていません。そもそもファイルがあるかないかを確認したいのです。
ファイルが存在しなければ拡張子の確認自体が必要ありません。(STEP.2、STEP.3は行わない)
STEP.2
次に70行目でファイルがある場合は、指定された拡張子のファイルなのか確認します。
指定された拡張子のファイルなのかを確認するには、GetExtensionNameメソッドを使います。
GetExtensionNameメソッドは、GetExtensionNameメソッドに指定されたファイル名から拡張子を取得するメソッドですが、その取得した拡張子と指定された拡張子が一致するかを70行目で判定します。
STEP.3
もし一致していれば75行目で、コピー先のフォルダの配下にファイルをコピーします。
ファイルのコピーはCopyFileメソッドを使います。
CopyFileメソッドの第1引数にはコピー元のファイル名を、第2引数にはコピー先のフォルダとそのフォルダ配下にコピーしたいファイル名を「¥」の文字でつなげて指定します。
なお、第1引数にはコピー元のファイル名はフルパスで指定します。(ファイル名だけを指定しない)
動作確認
マクロ実行前
コピー元フォルダのフォルダとコピー先のフォルダ、およびコピー対象にしたいファイルの拡張子を次のように指定してマクロを実行します。
今回コピー対象にしたいファイルの拡張子は複数あるので、カンマ区切りで複数を入力(dll,ini,csv)
マクロ実行後
マクロを実行すると、フォルダ構成そのままにサブフォルダ含めて全てのフォルダと、コピー対象にしたい拡張子のファイルだけが別フォルダにコピーされました。
※フォルダ数、ファイル数が多いので一部だけ結果をお見せします。
コピー元フォルダ
コピー先フォルダ
コピー元のファイル
コピー先のファイル
【注意】参照設定が必要です
一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。
参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。
- Windows Script Host Object Model(wshom.ocx)
なぜ必要かというと、Excelのマクロのコードの33行目の「FileSystemObject」というオブジェクトが「wshom.ocx」というファイルを参照するからです。
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。
ここでは「wshom.ocx」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「wshom.ocx」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。
最後に
本記事では、フォルダ構成そのままにサブフォルダ含めて全てのフォルダと指定した拡張子を含むファイルを別フォルダにコピーする方法についてご説明しました。
「再帰処理」という手法を使うことで、フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーすることができます。
「再帰処理」については「注目すべきコード①」の説明の中で触れていますのでそちらをご覧ください。
また、指定した拡張子を含むファイルを別フォルダにコピーするには次の処理の通りになります。
フォルダ構成そのままにフォルダをコピーしたい場合に、一部の拡張子のファイルもあわせてコピーしたい時には是非参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
