Macro to apply MP3 tags changes with VBA

[Lolica12]

Hi! So I got my whole Music Library in a Folder (+5000 Songs) and I wanted to rearrange the tags of the mp3 files and the file name.

So I got to this code to Read the properties of every mp3 file in a folder:


Sub Read_MP3_Files()
Dim FolderPath As Variant
Dim Item As Object
Dim oFile As Object
Dim oFolder As Object
Dim oShell As Object
Dim r As Long
Dim Rng As Range
' Prompt the user to select a folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
If .Show = -1 Then
FolderPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
Range("A1:H1") = Array("File Name", "Song Title", "Artist", "Album", "Year", "Genre", "Description", "Art Cover")
Set Rng = Range("A2")
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(FolderPath)
If oFolder Is Nothing Then
MsgBox "Folder was Not Found", vbExclamation
Exit Sub
End If
Set oFile = oFolder.Items
oFile.Filter 64, "*.mp3"
If oFile.Count = 0 Then
MsgBox "No MP3 Files Were Found in this Folder.", vbExclamation
Exit Sub
End If
For Each Item In oFile
With oFolder
Rng.Offset(r, 0) = .GetDetailsOf(Item, 0)
Rng.Offset(r, 1) = .GetDetailsOf(Item, 21)
Rng.Offset(r, 2) = .GetDetailsOf(Item, 20)
Rng.Offset(r, 3) = .GetDetailsOf(Item, 14)
Rng.Offset(r, 4) = .GetDetailsOf(Item, 15)
Rng.Offset(r, 5) = .GetDetailsOf(Item, 16)
Rng.Offset(r, 6) = .GetDetailsOf(Item, 25)
End With
r = r + 1
Next Item
End Sub

"

But now, I need another macro to then apply the changes that I will make on excel to those files.

I attached the file with the vba code, a example on it of some mp3 files that i had on a test folder.

( The file as a column named "Art Cover" that i intend to also give me the art cover of the mp3 files, but im going step by step first ) - Open for suggestions.

Thank you!

[June7]

Please post code between CODE tags to retain indentation and readability.

Why can I only see your sheet when workbook is Full Screen from the ribbon View tab?

I have opened workbooks like this before but was able to fix. I can't figure yours out.

Okay, had to select Arrange > Tiled from ribbon.

Review https://www.mrexcel.com/board/threads/vba-read-write-mp3-wma-properties-solved.269104/#:~:text=VBA%20READ%2FWRITE%20.MP3%20%26%20.WMA%20PROPERTIES%20%28SOLVED%29 %201,worksheet%20and%20update%20the%20file%20properties%20in%20Explorer.

[Lolica12]

Please post code between CODE tags to retain indentation and readability.

Why can I only see your sheet when workbook is Full Screen from the ribbon View tab?

I have opened workbooks like this before but was able to fix. I can't figure yours out.

Okay, had to select Arrange > Tiled from ribbon.

Review https://www.mrexcel.com/board/threads/vba-read-write-mp3-wma-properties-solved.269104/#:~:text=VBA%20READ%2FWRITE%20.MP3%20%26%20.WMA%20PROPERTIES%20%28SOLVED%29 %201,worksheet%20and%20update%20the%20file%20properties%20in%20Explorer.

-----------------------

Hi, i am sorry dont know what made it like that. I Inserted the file again, tell me if theres any problem this time.

I did saw that thread of 2007 but i never managed to put it working and thought maybe it could be simplified.

Here it is the code with tags:



Sub Read_MP3_Files()
' Declare variables
Dim FolderPath As Variant
Dim Item As Object
Dim oFile As Object
Dim oFolder As Object
Dim oShell As Object
Dim r As Long
Dim Rng As Range
' Prompt the user to select a folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
If .Show = -1 Then
' Store the selected folder path
FolderPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
' Write the Header's
ActiveSheet.Range("A1:I1").Value = Array("File Name", "Song Title", "Artist", "Album", "Year", "Genre", "Description", "File Path", "Art Cover")
' Set the starting range for data
Set Rng = ActiveSheet.Range("A2")
' Create a Shell object
Set oShell = CreateObject("Shell.Application")
' Set the folder using the Shell Namespace
Set oFolder = oShell.Namespace(FolderPath)
If oFolder Is Nothing Then
' Display an error message if the folder is not found
MsgBox "Folder was Not Found", vbExclamation
Exit Sub
End If
' Set oFile to the items in the folder
Set oFile = oFolder.Items
' Filter files to only include MP3 files
oFile.Filter 64, "*.mp3"
' Check if there are no MP3 files in the folder
If oFile.Count = 0 Then
' Display a message if no MP3 files are found
MsgBox "No MP3 Files Were Found in this Folder.", vbExclamation
Exit Sub
End If
' Loop through each MP3 file and extract details
For Each Item In oFile
With oFolder
' Extract and store details in the specified columns
Rng.Offset(r, 0) = .GetDetailsOf(Item, 0) ' File Name
Rng.Offset(r, 1) = .GetDetailsOf(Item, 21) ' Song Title
Rng.Offset(r, 2) = .GetDetailsOf(Item, 20) ' Artist
Rng.Offset(r, 3) = .GetDetailsOf(Item, 14) ' Album
Rng.Offset(r, 4) = .GetDetailsOf(Item, 15) ' Year
Rng.Offset(r, 5) = .GetDetailsOf(Item, 16) ' Genre
Rng.Offset(r, 6) = .GetDetailsOf(Item, 25) ' Description
Rng.Offset(r, 7) = .GetDetailsOf(Item, 194) ' File Path
End With
' Move to the next row
r = r + 1
Next Item
Range("B1").Select
End Sub


"

The goal would be to make a similiar macro to apply the changes after manually modifying it on excel.

31081

[Aussiebear]

Welcome to VBAX Lolica12. Please wrap your code with Code tags. See the first line in my signature for an example. When attaching files, please use Go advanced, Manage Attachments, Choose file, Upload and post it that way. Thank you

[June7]

You did not use CODE tags. Use the # icon on edit tool bar and post code between tags. A moderator already fixed your original post.

I am testing code now.

[June7]

Found this follow-up thread https://www.mrexcel.com/board/threads/read-write-mp3-file-tag-properties-solved.322393/page-2#posts

Also found similar at Stackoverflow https://stackoverflow.com/questions/64320487/how-to-use-excel-vba-to-update-mp3-file-properties-for-mp3-files-where-bit-rate.

Afraid that's as far as I going on this.