フォルダ構成だけをコピーするけどアルバムアート画像はやっぱりコピーする - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

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

このとき

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があったら、それはそっとしておく、ということになる。