再帰処理に初挑戦
再帰処理に初挑戦
前回
の続き。
Foobar2000用の音楽フォルダ管理の話。
とりあえず、フォルダの中身はコピーせずに、フォルダ構成だけを別フォルダにコピーしたい。
任意のフォルダ内の子フォルダだけを別のフォルダにコピーするマクロ
FileSystemObject
のSubFolders
コレクションとCreateFolder
メソッドを使えば楽勝。
リスト1 標準モジュール
'### Microsoft Scripting Runtime参照設定 ###' Option Explicit Private fsObj As FileSystemObject Public sub copyFolderStructure( _ ByVal srcDir As String, _ ByVal destDir As String) '……(1)' If fsObj Is Nothing Then _ Set fsObj = New FileSystemObject '……(2)' Dim tgtFolder As Folder '……(3)' Set tgtFolder = fsObj.GetFolder(srcDir) Dim subFolder As Folder '……(4)' For Each subFolder In tgtFolder.SubFolders fsObj.CreateFolder(destDir & "\" & subFolder.Name) '" Next End Function
(1)の
Public sub copyFolderStructure( _ ByVal srcDir As String, _ ByVal destDir As String)
で引数設定。
第1引数srcDir
でコピー元のフォルダパスを受け取り、第2引数destDir
でコピー先のフォルダパスを受け取る。
(2)の
If fsObj Is Nothing Then _ Set fsObj = New FileSystemObject
でFileSystemObject
のインスタンスを生成。
変数fsObj
はモジュールレベル変数なので、インスタンス化していないときだけSet
する。
(3)の
Dim tgtFolder As Folder Set tgtFolder = fsObj.GetFolder(srcDir)
では、FileSystemObject
オブジェクトのGetFolder
メソッドを用いて、コピー元のフォルダをFolder
オブジェクトとして取得。変数tgtFolder
にぶち込んでいる。
そして、(4)の
Dim subFolder As Folder For Each subFolder In tgtFolder.SubFolders Call fsObj.CreateFolder(destDir & "\" & subFolder.Name) '" Next
では、tgtFolder
オブジェクトのSubFolders
コレクションから子フォルダを一つづつ取り出してsubFolder
にぶち込み、そのName
プロパティを利用してコピー先のフォルダパスを作成。そうしてできたフォルダパスをCreateFolder
メソッドに渡してコピー先に新しいフォルダを作成する。
めちゃくちゃ簡単である。
リスト1の問題点
しかし、リスト1のやり方には問題点がある。
子フォルダの中にある孫フォルダ、曾孫フォルダ、……まではコピーできないのだ。
そこでどうするか。リスト1の(4)のところで、取り出した子フォルダ(subFolder
にぶち込まれたフォルダ)にさらに孫フォルダがあるときには、子フォルダをcopyFolderStructure
に渡すようにすればいいのである。
copyFolderStructure内からcopyFolderStructureメソッドを呼ぶ
リスト1を次のように書き換える。
リスト2 標準モジュール
Public sub copyFolderStructure( _ ByVal srcDir As String, _ ByVal destDir As String) If fsObj Is Nothing Then _ Set fsObj = New FileSystemObject Dim tgtFolder As Folder Set tgtFolder = fsObj.GetFolder(srcDir) Dim subFolder As Folder '……(5)' For Each subFolder In tgtFolder.SubFolders Dim newFolder As Folder Set newFolder = fsObj.CreateFolder( _ destDir & "\" & subFolder.Name) '" If subFolder.SubFolders.Count > 0 Then _ call copyFolderStructure( _ subFolder.Path, newFolder.Path) Next End Sub
変えたのは(5)のFor
ループのところ。
コピー先に新たに作ったフォルダを変数newFolder
にぶち込むようにしている。
そして、subFolder
にぶち込まれているフォルダについて、SubFolders
プロパティの値を調べ、0
よりも大きいとき、すなわちさらに孫フォルダがあるときには、subFolder
自身のフルパスと、先ほど作ったコピー先のnewFolder
のフルパスをcopyFolderStructure
に渡す。
これで、中にフォルダがある限り掘り進めて行ってくれる。
使ってみる
今回のマクロを書いたブックのあるフォルダ内に次のようなフォルダ群を準備。
Test1
とTest2
というフォルダが同じ階層にあり、そのうちTest1
フォルダの方には、ご覧のように子、孫フォルダが入っている。
ちなみに、当然Test2
フォルダの中は空っぽ。
この状態で、次のコードを実行する。
リスト3 標準モジュール
Private Sub testCopyFolderStructure() Dim srcDir As String srcDir = ThisWorkbook.Path & "\Test1" Dim destDir As String destDir = ThisWorkbook.Path & "\Test2" Call copyFolderStructure(srcDir, destDir) End Sub
copyFolderStructure
メソッドにTest1
フォルダのパスとTest2
フォルダのパスを渡しているだけ。
こいつを実行すると、Test2
フォルダの中は
こうなる。意図どおり。
おわりに
何となく今まで避けてきた「再帰処理」ですが、やってみたら意外と簡単でした。
ただ、積極的に使いどころを見いだしていくのはなかなかむつかしいかも知れません。
あと、Foobar2000の音楽フォルダ用に使うには、folder.jpg
があるときはそれもコピーする、という処理を追加する必要があります。