フォルダ構成だけをコピーするけどアルバムアート画像はやっぱりコピーする

楽曲データフォルダのフォルダ構成だけをコピーする(アルバムアートだけはコピーする)

このとき

akashi-keirin.hatenablog.com

の続き。

フォルダ構成だけをコピーするんだけど、アルバムアートファイルだけはコピーする。

私の場合、アルバムアートは、全部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があったら、それはそっとしておく、ということになる。

使ってみる

たとえば、

f:id:akashi_keirin:20190916142816g:plain

このTest1フォルダから、

f:id:akashi_keirin:20190916143715g:plain

このTest2フォルダにフォルダ構成をコピーする。

実行結果

Test2は、

f:id:akashi_keirin:20190916144110g:plain

こんな風になる。

おわりに

foobar2000使いの人はぜひどうぞ。