指定フォルダ内の全てのMP3ファイルのタグ情報を抽出する方法

今回は以前にご紹介した以下のネタの合わせ技で、

excellover.hatenablog.com

excellover.hatenablog.com

指定したフォルダ内(サブフォルダ含む)の全てのMP3ファイルの情報を抽出、

一旦セルに全て展開してみようと思います。

　合わせ技コード

早速ですが2つのネタを合わせて、多少の修正を加えたのが以下のコードです。

Dim MusicFileProperty() As Variant
Dim n As Long
Sub GetMusicFileProperty()
     n = 0
     'FileSearchで抽出したMP3ファイルのアドレスを蓄積するための配列
     ReDim MusicFileProperty(n)
     Dim StartTime As Double

’①
     'サブルーチンFileSearchで、指定したフォルダ内の全てのMP3ファイルを検索する
     FileSearch "G:\Music\"

     'FileSearchで取得したMP3ファイルのタグ情報をセルに転記する
     ReDim Preserve MusicFileProperty(UBound(MusicFileProperty) - 1)
     Range("A2").Resize(UBound(MusicFileProperty) + 1, 10).Value = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(MusicFileProperty))
End Sub
'-------------------------------------------------------------------------
Sub FileSearch(RootFolder As String)
     Dim myFSO As FileSystemObject
     Set myFSO = New FileSystemObject
          
     Dim myFolder  As Variant
     Dim MusicFile  As Variant
     
     'FileSystemObjectでファイルの検索・抽出を行う
     For Each MusicFile In myFSO.GetFolder(RootFolder).Files
          '拡張子がmp3のファイルのタグ情報を配列へ取り込む
          If LCase(myFSO.GetExtensionName(MusicFile)) = "mp3" Then
               MusicFileProperty(n) = Song_Property(myFSO.GetFile(MusicFile).Path)
               n = n + 1
               ReDim Preserve MusicFileProperty(n)
          End If
     Next

     '再帰処理でフォルダ内のフォルダの中身を検索
     For Each myFolder In myFSO.GetFolder(RootFolder).SubFolders
          FileSearch myFSO.GetFolder(myFolder).Path
     Next
     
     Set myFSO = Nothing
End Sub
'-------------------------------------------------------------------------
Function Song_Property(MusicFilePath As String) As Variant
     Dim FSO As FileSystemObject
     Dim objShell As Variant
     Dim objFolder As Variant
     Dim i As Long
     Dim n As Long
     Dim MusicFilePropertyColumn As Variant
     Dim Song As Variant
     Dim myArray(9) As Variant
     
     Set FSO = New FileSystemObject
     Set objShell = CreateObject("Shell.Application")
     Set objFolder = objShell.Namespace(FSO.GetFile(MusicFilePath).parentfolder & "\")
     Song = FSO.GetFile(MusicFilePath).Name
     
'②               
     MusicFilePropertyColumn = Array(14, 15, 16, 20, 21, 26, 27, 180, 195, 220)
     For i = 0 To 9
          myArray(i) = objFolder.getdetailsof(objFolder.parsename(Song), MusicFilePropertyColumn(i))
     Next i
     Song_Property = myArray
End Function

①各自の環境に合わせて音楽フォルダを指定してください。

②MP3タグのうち必要な項目を選択して、抽出したタグ情報を配列に格納。

１つの配列の中に１曲分の情報がまとまっていて、それをSong_Property関数の返り値としています。

上記のコードを新規ブックのモジュールにコピペして、「Microsoft Scripting Runtime」 に参照設定を行えば、正常に動くと思います。

　まとめ

指定したフォルダ以下のMP3ファイルからタグ情報を抽出して、セルに展開することができました。

実際に実行してみると多少の問題はあるのですが、当初予定していた動作は出来ているのでこのまま進めていこうと思います。

次回はタグ情報をセルに展開するのではなく、SQLite3データベースに取り込んでみようと思います。

おまけ

多少の問題

・抽出処理にちょっと時間がかかりすぎている(16,000件で13分)

・タグ情報が抽出できていない曲がある

気になるのでそこは原因追求・ブラッシュアップしていきたい。