フォルダ構成だけをコピーするけどアルバムアート画像はやっぱりコピーする
楽曲データフォルダのフォルダ構成だけをコピーする(アルバムアートだけはコピーする)
このとき
の続き。
フォルダ構成だけをコピーするんだけど、アルバムアートファイルだけはコピーする。
私の場合、アルバムアートは、全部folder.jpg
というファイル名で統一しているので、その前提で。
コード
Public Sub copyFolderStructure(ByVal sourceDir As String, _ ByVal destinationDir As String) Const ALBUM_ART_FILE As String = "\folder.jpg" If fsObj Is Nothing Then _ Set fsObj = New FileSystemObject Dim parentFolder As Folder Set parentFolder = fsObj.GetFolder(sourceDir) Dim subFolder As Folder For Each subFolder In parentFolder.SubFolders 'コピー先に同名のフォルダを作る' Dim newDir As String newDir = destinationDir & "\" & subFolder.Name '" If Not fsObj.FolderExists(newDir) Then _ Call fsObj.CreateFolder(newDir) 'アルバムアートファイルがあったらコピーする' Dim albumArtFullPath As String albumArtFullPath = subFolder.Path & ALBUM_ART_FILE 'フォルダ内に既にアルバムアートファイルがあったらコピーしない' If fsObj.FileExists(albumArtFullPath) Then _ If Not fsObj.FileExists(newDir & ALBUM_ART_FILE) Then _ Call fsObj.CopyFile(albumArtFullPath, newDir & ALBUM_ART_FILE) 'サブフォルダにさらにサブフォルダがあったらそれもコピー' If subFolder.SubFolders.count > 0 Then Call copyFolderStructure( _ subFolder.Path, destinationDir & "\" & subFolder.Name) '" End If Next End Sub
このメソッドに、コピー元のフォルダパスとコピー先のパスを渡して実行すると、フォルダ構成をコピーするだけでなく、コピー元のフォルダ内にfolder.jpg
という名前のファイルがあったら、そいつをコピー。コピー先にすでにフォルダがあって、その中にfolder.jpg
があったら、それはそっとしておく、ということになる。
使ってみる
たとえば、
このTest1
フォルダから、
このTest2
フォルダにフォルダ構成をコピーする。
実行結果
Test2
は、
こんな風になる。
おわりに
foobar2000使いの人はぜひどうぞ。