手持ちのMp3の管理をEXCELで

質問

手持ちのMp3の管理をしたいと思います。

私は、音楽(MP3)を３つの外付けHDD(USB)に分けて保存しています。
一度、それぞれのHDDのmp3をリストとしてC:ドライブに一括して登録して
HDDを接続していなくても曲の検索を行いたいと思います。

（HDDに新規登録した場合は、リストには追加して登録していく）

Excelを利用する事もできそうですが
　参考になる記事やテンプレートはありますか　？

回答No.9

kkkkkm · ベストアンサー

> Function FileSearch(Path As String, Target As String)の方は、
> 08:24の私の回答で変更済みでが
> No7のアドバイスでは何も指摘も有りませんでした。
> 変更前のNo.4のコードに戻すべきですか　？

はい、元に戻しても大丈夫だと思います。

お礼

kkkkkmさん、今回も最後まで教えていただいてありがとうございます。

提案を受けてNo.4のコードに戻しました。

エラー逃れで
On Error Resume Next　を利用して
何となく残念な状態でしたがこれで晴れ晴れしました。

お世話になりました。

回答No.8

kkkkkm

> アドバイスを受けて「\$Recycle.Bin」を読みに行かないように
> 下記のようにif文を追加しましたが
>
> >For Each Folder In FSO.GetFolder(Path).SubFolders
> > If Folder.Name <> "$Recycle.Bin" Then
> > Call FileSearch(Folder.Path, Target)
> > End If
> > Next Folder
>
> やはり同じエラーがでました。

$Recycle.Bin以外にもアクセス禁止(隠しフォルダ)のフォルダがあるのかもと思いますので

Test()の方で以下のようにしてみたらいかがでしょう。

For Each Folder In FSO.GetFolder(Path).SubFolders
If InStr(Folder.Path, "Documents and Settings") > 0 Then
'
ElseIf Not FSO.GetFolder(Folder.Path).Attributes And 2 Then
Call FileSearch(Folder.Path, Target)
End If
Next Folder

Documents and Settingsのショートカットは無いと思うのですが、外付けHDDの仕様が分からないので入れています。
必要なければ外してください。

Attributesについては以下を参照してください。
http://officetanaka.net/excel/vba/filesystemobject/folder01.htm

これで駄目な場合、すみませんが
On Error Resume Next
で逃げてください。

お礼

kkkkkmさん、

指摘された箇所を変更して
On Error Resume Next　で逃げなくても最後まで処理されました。
暫く使ってみて又同じエラーが出るなら
On Error Resume Next　を復活させます。

（サーチするHDD関連のショートカットは、存在しないと思いますが
先々の事を考えてコード残しました。）

Function FileSearch(Path As String, Target As String)の方は、
08:24の私の回答で変更済みでが
No7のアドバイスでは何も指摘も有りませんでした。
変更前のNo.4のコードに戻すべきですか　？

回答No.7

kkkkkm

> For Each Folder In FSO.GetFolder(Path).SubFoldersで
> Each Folderが「\$Recycle.Bin」を読みに行くとエラーが出ます。
>
> 実行エラー'70
> 書き込みが出来ません

\$Recycle.Bin
はシステムのゴミ箱のフォルダのようで、ルートにあるという事なので
(私が試したのはスマホのSDカードだったので無かったのだと思います)

Sub Test
のほうの

> For Each Folder In FSO.GetFolder(Path).SubFolders
> Call FileSearch(Folder.Path, Target)
> Next Folder

を

For Each Folder In FSO.GetFolder(Path).SubFolders
If Folder.Name <> "$Recycle.Bin" Then
Call FileSearch(Folder.Path, Target)
End If
Next Folder

にするとエラーにならないと思います。

それでもエラーになるようでしたら

Function FileSearch
のほうも変更してみてください。

お礼

kkkkkmさん、何度も訂正コードを教えていただきありがとうございます。

アドバイスを受けて「\$Recycle.Bin」を読みに行かないように
下記のようにif文を追加しましたが

>For Each Folder In FSO.GetFolder(Path).SubFolders
> If Folder.Name <> "$Recycle.Bin" Then
> Call FileSearch(Folder.Path, Target)
> End If
> Next Folder

やはり同じエラーがでました。

なので、Function FileSearchのほうも以下のように
if文を追加したのですが

For Each Folder In FSO.GetFolder(Path).SubFolders
If File.Name <> "$Recycle.Bin" then
Call FileSearch(Folder.Path, Target)
End If

For Each Folder In FSO.GetFolder(Path).SubFolders で
同じ書き込みエラーがでました。

For Each Folder In 　を見ると
　Folderは、$Recycle.Bin　と表示されています。

Function FileSearch　の修正が間違っていますか　？

解るにくいと現在の全コードを書き込みます。
（その後、No.6の訂正や追加したコードがあるので行数が増えています。）
おかしなところがあれば訂正をお願いします。

Sub Test()
Dim Path As String
Dim Target As String
Dim FSO As Object, Folder As Variant, File As Variant
Dim StartTime As Double, EndTime As Double
Dim ProcessTime As Double
Set FSO = CreateObject("Scripting.FileSystemObject")

Rows("2:" & Rows.Count).ClearContents

'On Error Resume Next

Target = "*" & "mp3"

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "フォルダを選択してください"
If .Show = False Then
Exit Sub
End If
Path = .SelectedItems(1)
End With

'参考http://officetanaka.net/excel/vba/tips/tips36.htm

MsgBox "処理を開始します。"

'開始時間取得
StartTime = Timer

For Each Folder In FSO.GetFolder(Path).SubFolders
If Folder.Name <> "$Recycle.Bin" Then
Call FileSearch(Folder.Path, Target)
End If
Next Folder

For Each File In FSO.GetFolder(Path).Files
If File.Name Like Target Then
Call DataWrite(File.ParentFolder, File.Name)
End If
Next File

'終了時間取得
EndTime = Timer
'処理時間
ProcessTime = EndTime - StartTime

MsgBox "処理が終了しました。" & Chr(13) & "処理時間: " & ProcessTime & " 秒"

End Sub

Function FileSearch(Path As String, Target As String)
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")

For Each Folder In FSO.GetFolder(Path).SubFolders
If Folder.Name <> "$Recycle.Bin" Then
Call FileSearch(Folder.Path, Target)
End If
Next Folder

For Each File In FSO.GetFolder(Path).Files
If File.Name Like Target Then
Call DataWrite(File.ParentFolder, File.Name)
End If
Next File
End Function

Function DataWrite(ByVal ParentFolder As String, ByVal File As String)
Dim LastRow As Long
Dim tmp As String

With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Cells(LastRow + 1, "A").Value = Mid(ParentFolder, InStrRev(ParentFolder, "\") + 1)
.Cells(LastRow + 1, "B").Value = File
End With
End Function

回答No.6

kkkkkm

回答No.4ふたたびの訂正です。

Sub Testの

> Target = "mp3"
を
Target = "*" & "mp3"
に

「&」で繋がなくても
Target = "*mp3"
でいいのですが、前者の方がわかりやすいかなと思います

それにともなって

> Call FileSearch(Folder.Path, "*" & Target)
を
Call FileSearch(Folder.Path, Target)

に変更してください。

すぐ下に
If File.Name Like Target Then
があるのを見逃してました。
上記をやらずにこちらを
If File.Name Like "*" & Target Then
にすればいいのですが、

Sub TestとFunction FileSearchの中のTargetで「値」が違うのも気持ち悪い(勘違いのもとなども)気もしますので訂正します。

回答No.5

kkkkkm

回答No.4訂正です。(ただ、訂正しなくても動作に支障は無いと思います)

.ParentFolderがあるのを忘れてました(あるものは使いたいので一応訂正です)

> Call DataWrite(File.Path, File.Name)

これが
Sub Test
と
Function FileSearch
の2か所にありますから以下に

Call DataWrite(File.ParentFolder, File.Name)

Function DataWrite
の
> Function DataWrite(ByVal Path As String, ByVal File As String)
を
Function DataWrite(ByVal ParentFolder As String, ByVal File As String)

> tmp = Replace(Path, "\" & File, "")
> .Cells(LastRow + 1, "A").Value = Mid(tmp, InStrRev(tmp, "\") + 1)

上の2行を以下の1行に

.Cells(LastRow + 1, "A").Value = Mid(ParentFolder, InStrRev(ParentFolder, "\") + 1)

それぞれ変更してください。

回答No.4

kkkkkm

以下で試してみてください。

フォルダ選択のダイアログが開きますので適切なドライブ(フォルダ)を選択して実行すると
ドライブ(フォルダ)配下の全てのフォルダ内のmp3を調べて

たとえば

X:\#K\#KAI\KAI2\Kai2 - Jump\01. Evolution2.mp3
の場合
A列に
Kai2 - Jump
B列に
01. Evolution2.mp3
が入ります。

Sub Test()
Dim Path As String
Dim Target As String
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")

Target = "mp3"

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "フォルダを選択してください"
If .Show = False Then
Exit Sub
End If
Path = .SelectedItems(1)
End With

'参考http://officetanaka.net/excel/vba/tips/tips36.htm

For Each Folder In FSO.GetFolder(Path).SubFolders
Call FileSearch(Folder.Path, "*" & Target)
Next Folder
For Each File In FSO.GetFolder(Path).Files
If File.Name Like Target Then
Call DataWrite(File.Path, File.Name)
End If
Next File

End Sub

Function FileSearch(Path As String, Target As String)
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
Call FileSearch(Folder.Path, Target)
Next Folder
For Each File In FSO.GetFolder(Path).Files
If File.Name Like Target Then
Call DataWrite(File.Path, File.Name)
End If
Next File
End Function

Function DataWrite(ByVal Path As String, ByVal File As String)
Dim LastRow As Long
Dim tmp As String

With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
tmp = Replace(Path, "\" & File, "")
.Cells(LastRow + 1, "A").Value = Mid(tmp, InStrRev(tmp, "\") + 1)
.Cells(LastRow + 1, "B").Value = File
End With
End Function

お礼

kkkkkmさん、毎度お世話になっています。

No.5（No.4改訂版)をVBAで標準モジュールに書き込んで試してみました。

For Each Folder In FSO.GetFolder(Path).SubFoldersで
Each Folderが「\$Recycle.Bin」を読みに行くとエラーが出ます。

実行エラー'70
書き込みが出来ません

なので「On Error Resume Next」をコードの最初に挿入して処理を継続するようにしました。
一応、これでファオルダー内のmp3ファイルは拾えているようなので問題ないと考えています。

今回も教えていただきありがとうございます。

何かコメントあればお願いします。

回答No.3

imogasi

小生は、MP3などの全くの素人です。
昨日＃１の回答の際に、WEB記事を覗いていたら、下記のもの（VBAのコード）がありました。
そのMP3曲のプロパティ情報には下記のものが出ました。WEB記事を、多少追加や修正してます。
Sub Song_Property()
Dim FSO As Object
Dim objShell As Variant
Dim objFolder As Variant
Dim i As Long
Dim Song As Variant

Set FSO = CreateObject("Scripting.Filesystemobject")
Set objShell = CreateObject("Shell.Application")
'Set objFolder = objShell.Namespace("G:\Music\Frost\Milliontown\")
Set objFolder = objShell.Namespace("C:\Users\XXX\Downloads\")　'＜ーー自分のものに修正
'Song = FSO.getfile("G:\Music\Frost\Milliontown\01 Hyperventilate.mp3").Name
Song = FSO.getfile("C:\Users\惇\Downloads\Tchaikovsky_Swan_Lake_introduction.mp3").Name
Set wb = ActiveWorkbook
For i = 0 To 1000
wb.Worksheets("Sheet1").Cells(i + 1, 1).Value = i
'ファイルのプロパティ名を取得
wb.Worksheets("Sheet1").Cells(i + 1, 2).Value = objFolder.getdetailsof(objFolder.parsename(objFolder), i)
'ファイルのプロパティ値を取得
wb.Worksheets("Sheet1").Cells(i + 1, 3).Value = objFolder.getdetailsof(objFolder.parsename(Song), i)
Next i
End Sub
ーーー
プロパティ項目の一部
0 名前 Tchaikovsky_Swan_Lake_introduction.mp3
1 サイズ 3.15 MB
2 項目の種類 MP3 ファイル
3 更新日時 2022/10/24 18:55
4 作成日時 2022/10/24 18:54
5 アクセス日時 2022/10/25 9:06
6 属性 A
7 オフラインの状態
8 利用可能性
9 認識された種類 オーディオ
10 所有者 KWGYSSN-PC\oto
11 分類 音楽
12 撮影日時
13 参加アーティスト Windy
14 アルバム MIDI CLASSICS
15 年 2012
16 ジャンル クラシック
以下の項目　略。
だから、ｍｐ３曲だけが入っているフォルダーがあれば、それらの曲の、上記項目は、VBAで自動で、エクセルの表にできる可能性があると思います。
＝＝＝
後は、質問者が、こいうこと（ＶＢＡ関連）が好きか？すこし凝り性か（ＷＥＢ記事を根気よく探すなど）？
にかかっていると思う。
ー
でも前回の質問でも、お礼の文言からでは、その後に、突き詰めていないようだから、また＃１の反応（お礼）も、言っていることが、核心をついていないと思うから、
本件については、一般的な、楽曲情報の整理のための、フリーのソフトでも探したらどうか？
それ以上の、表の指定箇所のワンクリックで、その曲の演奏が始まるかどうかは、ほぼすべてのソフトにおいて、当然では、ないでしょう。

回答No.2

imogasi

#1です。VBAについて、下記は参考に。MP３曲を演奏するVBAは下記のようなもののようです。WEBにありました。
チャイコフスキーの曲をWEBからダウンロードして、テストしました。
Sub Sample1()
Dim SoundFile As String
SoundFile = "C:\Users\xxx\Downloads\Tchaikovsky_Swan_Lake_introduction.mp3"
If Dir(SoundFile) = "" Then
MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation
Exit Sub
End If
Shell "mplay32.exe /play /close " & SoundFile
End Sub
実行すると、曲が流れました。

お礼

imogashiさん、回答ありがとうございます。

以前、VBAの質問をしたときにimogashiさんからも回答をいただきました。
なのでVBAは素人レベルなので使いこなすまではスキルが有りませんが
利用することはできると思います。

「管理」に付いて惑わせているようですが、単純に「曲目リスト」と考えてください。
Mp3の再生などの機能は全く必要ありません。

mp3については、ファイル名が分かればいいので属性情報は必要ではありません。
Xドライブにあるmp3の実際の例を挙げますと、

　　X:\#K\#KAI\Kai - Jump\01. Evolution.mp3
　　で最後のアルバム名\曲名が必要なので
　　Kai- Jump\01.Evolution をTEXTファイルで１曲名分１行でEXCELへ書き出したい。

　　（ただし、
　　　　mp3の階層は一定では無く各mp3により変化します。
　　　　例えば、
　　　　X:\#K\#KAI\KAI2\Kai2 - Jump\01. Evolution2.mp3　の場合は
　　　　　　　Kai2 - Jump\01. Evolution2.mp　が必要箇所となります。）

回答No.1

imogasi

私は門外漢です。
でも、私の想像では、本件をやるには、エクセル側で、最低でも、エクセルVBAができることが、必要だと思います。
そしてMP３のファイルには
http://officetanaka.net/other/extra/tips16.htm
にあるように、曲の長さやタイトルなどがファイルに記録されているのですか？その他の属性情報はどんなものが、あるのですか。その項目はみな（どの曲でも）一律に揃って記録されて、いないのではないですか？
https://www.excellovers.com/entry/2018/04/22/221602
MP3からTag情報を抽出する方法
ーー
質問では、「管理」とか、難しいことを言っているが、タイトルと属性（Tag情報？）をエクセルのシートに一覧として記録し、（１曲名分１行か？）、これを随時、どれかのキーワードで検索する（記録があるかどうか、と内容）程度しかできないでしょう。これだけでも、相当VBAの技量が要ると思う。質問の書き振り（詳細が整理されていない。プログラム経験者と思えない）から、到底そこまでは質問者は至っていないように想像する。
ーー
その１指定タイトルの行をクリックすると、曲の演奏が始まる、ようにするなどは、また別のプログラム（コード）を作る技量が要ると思う。
また、HDDに曲を登録したときに、エクセルのMP３曲の管理表に自動で登録するのも、なかなか難しいでしょう。
なお、上記のWEB記事は、TANAKA（田中　亨)先生のもので、この方は、日本での、VBAの関しては第1人者と、小生は思う人のものです。
＝＝＝
結局VBAでこれらをやるには、相当VBAの経験がないと無理と思います。
＝＝＝
WEB記事でも、丹念に調べて、セミプロレベルの人が作った、本件に沿った、内容のフリーソフトでもないか、探すしかないでしょう。
＝＝＝
MP３曲の演奏は、概略のことは
http://rucio.a.la9.jp/main/technique/teq_1.htm
が参考になると思う。ここに書いてある、VB6はVBAと文法的に兄弟のようなものです。でも今はVB６は手に入らないでしょう。