VBA READ/WRITE .MP3 & .WMA PROPERTIES (SOLVED)

[BrianB]

This message has 3 parts - *INTRODUCTION - *READ CODE - *WRITE CODE

INTRODUCTION
I have had a long-held belief that Excel/VBA methodology is very suited to solving this problem. I have investigated several possible methods noted below and picked one that gives a "quick win". I offer my results so far as a step towards the goal, as well as giving an example of how to manipulate a non-MS Office application using VBA. In this case Windows Explorer - I have used similar code on corporate applications like Oracle and SAP. My 'Write' method uses Sendkeys. Luckily I have been able to do the job without having to use code to simulate mouse functions or using API calls to simulate key presses. Ideally I would like to use something more stable, but there is the bonus that it is simple, as well as changing WMA and both versions of MP3 tag (see below) if present. Perhaps on reading this someone else may have a better method.

Being a ballroom dancer I have a large collection of CDs as well as software to rip to hard drive and enhance the sound quality. Many are quite old. A big problem has been to get a consistent view of the file properties - especially Genre, (eg. Waltz, Foxtrot .. etc.) which, from my own CD burning or external sources, is missing, or incorrect from using the now obsolete ID3v1 tag standard list. Applications such as Windows Media Player and RealPlayer allow functionality to edit tags but become very tiresome when it comes to making bulk changes - such as after burning a new CD. When viewing properties of the same file in various other applications they often show things like Title & Artist switched, and Genre not at all. I have tried software to change MP3 file tags, but find them over-complicated, confusing, and difficult to make the bulk changes I need. With Windows Explorer we can only change 8 properties - but I find these sufficient.

My method is :-
1. READ : Run one macro to put data into a worksheet.....
2. MAKE CHANGES : Make manual changes to the Excel worksheet in the normal way....
3. WRITE : Run another macro to read the worksheet and update the file properties in Explorer.
Part 1 is very simple and robust. Part 3 is difficult because when we use Sendkeys to mimic keyboard entry the code runs too fast to allow time for things to happen on screen, so we have to put Wait statements *depending on how fast the computer runs*. So Slower is better - up to a point.

Properties are added to MP3 files by using a "Tag" - additional bytes of information which form part of the file. WMA files are a Microsoft invention using a similar, but different structure. Interestingly, using my code to make changes via Window Explorer updates BOTH MP3 Tag versions as well as .WMA files. I moan about Microsoft less and less.

MP3 *ID3v1* consisting of 128 bytes always at the end of the file is now 'obsolete' - despite being still in use. This is very easy to read/write using the same code as for Text Files eg.

Open "c:\myfile.mp3" For Binary As #1

etc. It is, however, limited to 4 text fields of 30 characters max, 'Year' =4 characters, and 'Genre' is a single character, the Asc() code of which is a lookup to a standard list which contains 125 items - none of which is any good to me. Could have my own lookup I suppose.

MP3 *ID3v2.3* is in the process of being superseded by ID3v2.4. The big problem here is that there are several different versions and the code required is extremely complicated - mainly due to the use of variable length fields. So we not only have to find the property, but read the field length before getting the field contents. Writing would need to change the coded field length. This is further complicated by there being the option to use an "Extended Tag" - *or not* ! Version 2 tag can be at the beginning or end of the file (before ID3v1 if it exists) - or both. The MP3 files on my computer all seem to have both versions - v2 at the beginning and v1 at the end. It is further complicated by the ability to have User Defined fields. I see some of my files have a user defined 'Genre' field, despite having the standard one 'TCON' too. The tag also needs a form of "encryption" so that the mp3 player does not treat it as audio data. Visit here for detailed information http://www.id3.org .

To view an audio file in its raw state open it in a Text Editor. I use 'TexPad' which is very fast and gives a choice of Binary (with Text 'translation' in a column) or Text view. Notepad gives just a Text view with empty space for non-text/binary characters. There is a large number of Null characters Asc(0) in proportion to the overall file length - mainly for "future development" I believe.

I would be interested to hear of any comments, suggestions and code improvements.

READ CODE IS IN THE "REPLY" BELOW

 

[BrianB]

Copy/paste this to its own module. WRITE code is in the "reply" below.

'============================================================================================================
'- MACRO TO :-
'- *1. SELECT A FOLDER -  *2. CLEAR THE ACTIVE WORKSHEET*  -  *3. READ .MP3 & .WMA EXTENDED FILE PROPERTIES*
'- ONLY EXTRACTS FILE DATA SO CAN BE USED ON ITS OWN. SHEETS CAN BE SAVED AS NORMAL
'- CAN THEN RUN MACRO "WRITE_TO_EXPLORER" (in another module below) TO *CHANGE* PROPERTIES
'- Uses Windows Shell32.dll (Requires Tools/References .. 'Microsoft Shell Controls And Automation')
'- Brian Baulsom July 2007 - using Excel 2000/Windows XP
' ==========================================================================================================
'- Method (works on all files in a single folder)
'- 1. Run macro "READ_FROM_EXPLORER" below TO GET FILE NAMES INTO CURRENTLY ACTIVE WORKSHEET
'- 2. Manually amend file details in the worksheet.Delete rows for files not changed saves time(can be left)
'- 3. Run macro "WRITE_TO_EXPLORER" (other module)
'===========================================================================================================
Option Base 1                       ' MyProperties(15) starts 1 instead of 0
Dim MyFilePathName As String        ' Local variable full path & file name
Public MyPathName As String         ' **Public variable     |enables 'Sub GetPathFileNameFromFullPath()'|
Public MyFileName As String         ' **Public variable     |usage in 'WRITE_TO_EXPLORER' macro         |
'- Properties Array (list of integers)
Dim Arr1 As Variant                 ' "Name"= shell property zero + properties in Windows Explorer
Dim Arr2 As Variant                 ' some more shell GetDetailsOf() property numbers (0-34 available. 3 unused)
Dim MyProperties(15) As Integer     ' Shell property index numbers used here. Puts them in required order
Dim MyPropertyNum As Integer        ' Array item position 1-15
Dim MyPropertyVal As Variant        ' Lookup Array data shell property numbers 0,16, 17 ... etc.
'-
Dim ws As Worksheet
Dim ToRow As Long                   ' write to worksheet row number
'- Shell variables
Dim ShellObj As Shell
Dim MyFolder As Folder
Dim MyFolderItem As FolderItem
'-

'===========================================================================================================
'- MAIN ROUTINE
'===========================================================================================================
Sub READ_FROM_EXPLORER()
    '-------------------------------------------------------------------------------------------------------
    '- GET FOLDER - Method 1 - using Windows Dialog (comment out if not required)
    MsgBox ("Selecting a single file in the following dialog gets the required *FOLDER*." & vbCr & vbCr _
             & "NB. CLEARS THE CURRENTLY ACTIVE SHEET." & vbCr & vbCr _
             & "Saves having to use 'BrowseForFolder' code.")
    MyFilePathName = _
        Application.GetOpenFilename("Audio Files (*.mp3;*.wma),*.mp3;*.wma", , "        GET FOLDER REQUIRED")
    If MyFilePathName = "False" Then Exit Sub
    GetPathFileNameFromFullPath MyFilePathName  ' subroutine to separate folder & file name
    '-------------------------------------------------------------------------------------------------------
'    '- GET FOLDER - Method 2 - hard coded for testing (comment out if not required)
'    MyPathName = "C:\TEMP\MP3_TEST"            ' SET AS REQUIRED
    '=======================================================================================================
    Set ShellObj = New Shell
    Set MyFolder = ShellObj.NameSpace(MyPathName)
    '------------------------------------------------------------------------------------------
    ChDrive MyPathName
    ChDir MyPathName
    Set ws = ActiveSheet
    ToRow = 2
    ws.Cells.ClearContents                ' clear worksheet
    ws.Cells.Interior.ColorIndex = xlNone
    '-------------------------------------------------------------------------------------------
    '- INITIALISE PROPERTY ARRAY. CLEAR & SET UP WORKSHEET
    '- Set up array to sort properties into the required order
    '- do not change Arr1 (list of changeable fields in Windows Explorer - used in WRITE macro.)
    '      "Name", "Artist", "Album", "Year", "Track", "Genre", "Lyrics", "Title","Comments")
    Arr1 = Array(0, 16, 17, 18, 19, 20, 27, 10, 14)
        For n = 1 To 9: MyProperties(n) = Arr1(n): Next
    '-     "Duration", "Size", "Date Modified", "Category", "Author", "Bit Rate"
    Arr2 = Array(9, 12, 3, 1, 22, 33)
        For n = 10 To 15: MyProperties(n) = Arr2(n - 9): Next
    '-------------------------------------------------------------------------------------------
    '- write worksheet header
    For n = 1 To 14
        ws.Cells(1, n).Value = MyFolder.GetDetailsOf(MyFolder.Items, MyProperties(n))
    Next
    With ws
        '- "Lyrics" is not included in the Shell properties. I have used a blank one item 27
        .Cells(1, "G").Value = "Lyrics"
        '- This is useful for other purposes.  eg. to play the track via macro.
        .Cells(1, "O").Value = "Full Name"
        .Range("A1:O1").Interior.ColorIndex = 37    ' Dark blue header
    End With
    '===========================================================================================
    '- GET FILE NAMES & PROPERTIES FROM FOLDER
    '===========================================================================================
    MyFileName = Dir(MyPath & "*.*")   'first file name
    Do While MyFileName <> ""
        '- filter .MP3 & .WMA
        If UCase(Right(MyFileName, 3)) = "MP3" Or UCase(Right(MyFileName, 3)) = "WMA" Then
            Set MyFolderItem = MyFolder.ParseName(MyFileName)
            '--------------------------------------------------------------------
            '- properties to worksheet
            For MyPropertyNum = 1 To 14
                MyPropertyVal = MyFolder.GetDetailsOf(MyFolderItem, MyProperties(MyPropertyNum))
                ws.Cells(ToRow, MyPropertyNum).Value = MyPropertyVal
            Next
            '---------------------------------------------------------------------
            '- add full path\file name (used as lookup by "WRITE_TO_EXPLORER")
            ws.Cells(ToRow, 15).Value = MyPathName & "\" & MyFileName
            ToRow = ToRow + 1
        End If
        MyFileName = Dir    ' Get next file name
    Loop
    '-------------------------------------------------------------------------------------------
    '- finish
    ws.Activate
    ws.UsedRange.Columns.AutoFit
    '- colour editable range -> blue
    If ToRow > 2 Then ws.Range("B2:I" & ws.Range("A2").End(xlDown).Row).Interior.ColorIndex = 34
    MsgBox ("Done." & vbCr & "Auto editable properties in blue" & vbCr _
                    & "used by macro" & vbCr & "'WRITE_TO_EXPLORER'")
End Sub
'=========== END OF MAIN ROUTINE ===============================================================
'===============================================================================================
'- SUB TO SEPARATE PATH & FILE NAME FROM FULL NAME
'- puts to Public module level variables 'MyFileName' & 'MyPathName'
'===============================================================================================
Public Sub GetPathFileNameFromFullPath(Nm As String)
    For c = Len(Nm) To 1 Step -1
        If Mid(Nm, c, 1) = "\" Then
            MyFileName = Right(Nm, Len(Nm) - c)
            MyPathName = Left(Nm, Len(Nm) - Len(MyFileName) - 1)
            Exit Sub
        End If
    Next
End Sub
'----------------------------------------------------------------------------------------------

 

[BrianB]

Copy/Paste to its own module same file as READ code which needs to be present too because this code uses a function it contains. Note that *holding down* F10 key will stop the macro.

'==========================================================================================================
'- MACRO TO WRITE EXTENDED FILE PROPERTIES INFO TO .MP3 AND .WMA FILES IN WINDOWS EXPLORER
'- ONLY MIMICS KEYBOARD ENTRY - BUT BECAUSE IT CHANGES FILES YOU USE IT AT YOUR OWN RISK
'- Suggest you copy some files to a special folder for testing first.
'- Use of Sendkeys is not an exact science.
'- CHANGES BOTH ID3v1 AND ID3v2 MP3 TAGS IF PRESENT. .WMA FILES USE A DIFFERENT METHOD
'- Brian Baulsom July 2007  - using Excel 2000/Windows XP
'==========================================================================================================
'- Method  (works on all files in a single folder)
'- 1. Run macro "READ_FROM_EXPLORER" (other module) TO GET FILE NAMES INTO CURRENTLY ACTIVE WORKSHEET
'- 2. Amend file details in the worksheet. Delete rows for files not changed to save time (can be left).
'- 3. Run macro "WRITE_TO_EXPLORER" below.   ** DO NOT USE YOUR MOUSE OR KEYBOARD WHILE THIS IS RUNNING **
'-    [HOLD DOWN F10 KEY TO STOP THE MACRO].   WE CAN ONLY CHANGE THE FIRST 8 PROPERTIES
'==========================================================================================================
'- Opens Explorer folder - selects files in turn - uses menu File/Properties to make changes
'- Uses Sendkeys() to mimic keyboard
'==========================================================================================================
'- * DO NOT USE THE MOUSE OR KEYBOARD WHILE THIS RUNS
'- * BEFORE RUNNING : OPEN EXPLORER File/Properties and make sure "General" tab is on top.
'- * If this fails to function on your machine, start by increasing the WAIT times (Sub WAIT1() .. etc.)
'- * Use a folder on local hard drive (not server) due to variable access times.
'==========================================================================================================
'- to get Explorer folder
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Const CSIDL_WINDOWS = &H24
'---------------------------------------------------------------------------------------------------------
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long
'---------------------------
Private Type ****EMID
    cb As Long
    abID As Byte
End Type
'---------------------------
Private Type ITEMIDLIST
    mkid As ****EMID
End Type
'---------------------------------------------------------------------------------------------------------
'- To check for F10 key
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Const MePressed = &H1000
'---------------------------------------------------------------------------------------------------------
Dim ws As Worksheet
Dim FromRow As Long
Dim FilesToChange As Integer    ' number of files to change
Dim FilesChanged As Integer     ' number of files changed
Dim ExitLoop As Boolean         ' exit loop when all files changed
'-
Dim MyFilePathName As String    ' full path & file name
Dim MyFileType As String        ' mp3 - might work with some others
Dim LastFileChecked As String   ' In Explorer DownArrow doesn't move beyond the last file
'Dim MyFileName As String        ' Public variable in 'READ_FROM_EXPLORER' macro
'Dim MyPathName As String        ' Public variable in 'READ_FROM_EXPLORER' macro
'- for Sendkeys()
Dim Alt As String
Dim Ctrl As String
Dim MyTab As String
Dim S As String
'-
Dim MyClipData As DataObject    'Tools/References ....  'Microsoft Forms2 Object' Library
Dim MyNewValue As String
Dim FoundCell As Object
Dim MacroPosition  As String    ' to show where error occurs
'-----------------------------------------------------------------------------------------------------------
'==========================================================================================================
'- MAIN ROUTINE
'==========================================================================================================
Sub WRITE_TO_EXPLORER()
    Application.Calculation = xlCalculationManual
    Set ws = ActiveSheet
    Set MyClipData = New DataObject                     ' to manipulate the Clipboard
    FilesToChange = ws.Range("A2").End(xlDown).Row - 1  ' count worksheet rows
    FilesChanged = 0
    '--------------------------------------------------
    '- for Sendkeys
    Alt = "%"
    Ctrl = "^"
    MyTab = "{TAB}"
    '-------------------------------------------------------------------------------------------------
    '- GET FOLDER NAME FROM FIRST FOLDER\FILE IN THE WORKSHEET
    MyFilePathName = ws.Range("O2").Value
    If InStr(1, MyFilePathName, "\", vbTextCompare) = 0 Then 'there is no "\" in the path
        MsgBox ("First file\path invalid." & vbCr & MyFilePathName)
        Exit Sub
    End If
    GetPathFileNameFromFullPath (MyFilePathName)    ' PUBLIC SUBROUTINE IN 'READ_FROM_EXPLORER' module
    '-------------------------------------------------------------------------------------------------
    '- Open Windows Explorer
    OPEN_FOLDER MyPathName                          ' SUBROUTINE BELOW
    Application.Wait Now + TimeValue("00:00:02")    ' WAIT 2 SECONDS
    S = "(" & Alt & " )x"
    SendKeys S, True                                ' MAXIMIZE WINDOW Alt+Space-x
    WAIT1
    '-----------------------------------------------------------------------------
    '- select top file
    SendKeys "{DOWN}", True
    SendKeys "{HOME}", True
    WAIT1
    '-----------------------------------------------------------------------------
    '- RUN THROUGH FILES IN EXPLORER
    LastFileChecked = ""
    ExitLoop = False
    '-----------------------------------------------------------------------------
    '- loop files
    While ExitLoop = False
        ChangeFileProperties                ' subroutine below
        '- check if last Explorer file
        If MyFileName = LastFileChecked Or FilesChanged = FilesToChange Then
            ExitLoop = True
        Else
            LastFileChecked = MyFileName    ' name of file just processed
            SendKeys "{DOWN}", True         ' select next file
            WAIT1
        End If
        '- see if user wants to stop the macro
        CHECK_F10_KEY
    Wend
    '-----------------------------------------------------------------------------
    '- end of program
    AppActivate Application.Caption     ' activate Excel
    ws.Activate
    Application.Calculation = xlCalculationAutomatic
    MsgBox ("Done" & vbCr & "Changed " & FilesChanged)
End Sub
'========= END OF MAIN ROUTINE ============================================================================
'==========================================================================================================
'- THIS SUBROUTINE CHANGES SHELL FILE PROPERTIES . Called from  MAIN ROUTINE
'- Check file name in Explorer folder. If found in worksheet get new properties.
'==========================================================================================================
Private Sub ChangeFileProperties()
    CHECK_F10_KEY       ' see if user wants to stop the macro
    On Error GoTo ErrorMessage1
    MacroPosition = "Access File Properties" ' to locate error
    '=====================================================================================
    '- FILE PROPERTIES DIALOG
    '=====================================================================================
    S = "(" & Alt & "F)"
    SendKeys S, True                                ' Open Menu .. File ...
    Application.Wait Now + TimeValue("00:00:02")
    SendKeys "r", True                              ' .. Properties
    WAIT1
    '=====================================================================================
    '- FILE PROPERTIES : 'GENERAL' TAB
    '=====================================================================================
    MacroPosition = "General"       ' to locate error
    S = "(" & Alt & "H)"
    SendKeys S, True                ' to set starting position at "Hidden"
    SendKeys " ", True              ' Space to remove "Hidden" check
    WAIT1
    '--------------------------------------------------------------------------------------
    '- 6 Tabs to get to the File Name textbox
    For t = 1 To 6
        Beep
        SendKeys MyTab, True
        CHECK_F10_KEY           ' see if user wants to stop the macro
        WAIT1
    Next
    '---------------------------------------------------------------------------------------
    '- Copy file name from dialog (which Windows has now selected)
    S = "(" & Ctrl & "C)"
    SendKeys S, True
    WAIT1
    '---------------------------------------------------------------------------------------
    '- Get 'MyFileName' from Clipboard
    MacroPosition = "Get 'MyFileName'"       ' to locate error
    With MyClipData
        .GetFromClipboard
        MyFileName = .GetText(1)
        .Clear
    End With
    '----------------------------------------------------------------------------------------
    '- check if at the last file (Explorer selection has not moved from previous)
    If MyFileName = LastFileChecked Then
        Exit Sub
    End If
    '-----------------------------------------------------------------------------------------
    '- Check worksheet for MyFileName (row may have been deleted as not changed)
    MacroPosition = "Check worksheet"       ' to locate error
    '- Find file name in sheet
    With ws.Columns("A").Cells
        Set FoundCell = ws.Columns("A").Cells.Find(What:=MyFileName, After:=.Range("A1"), _
                        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False)
    End With
    If FoundCell Is Nothing Then    ' not in worksheet - no change required
        '- do nothing.
        GoTo ExitDialog             ' Exit dialog. Get next file.
    Else
        FromRow = FoundCell.Row     ' worksheet row to get data
    End If
    '========================================================================================
    '- FILE PROPERTIES : 'SUMMMARY' TAB
    '========================================================================================
    MacroPosition = "Get Summary tab"   ' to locate error
    S = "(" & Ctrl & MyTab & ")"
    SendKeys S, True
    WAIT1
    '- make sure Advanced properties tab is selected
    '- hopefully this is "lost" if the correct tab is already there
    S = "(" & Alt & "v)"
    SendKeys S, True        ' 'Advanced' button
    WAIT1
    '--------------------------------------------------------------------------
    '- Move down items in Summary and make changes
    SendKeys "{HOME}", True     ' go to top item (Artist)
    WAIT1
    '--------------------------------------------------------------------------
    '- loop properties. Data from worksheet - to clipboard - pasted to Explorer
    For p = 2 To 9
        Beep
        MyNewValue = ws.Cells(FromRow, p).Value
        With MyClipData
            .SetText MyNewValue
            .PutInClipboard
        End With
        S = "(" & Ctrl & "V)"
        SendKeys S, True
        WAIT1
        SendKeys "{ENTER}", True
        WAIT1
        '- next proprty
        SendKeys "{DOWN}", True
        CHECK_F10_KEY       ' see if user wants to stop the macro
        WAIT1
    Next
    '-------------------------------------------------------------------------
    ' register that change has been made
    FilesChanged = FilesChanged + 1
    '-------------------------------------------------------------------------
    '- Exit dialog
ExitDialog:
    MacroPosition = "Exit dialog"      ' to locate error
    SendKeys "{ENTER}", True           ' close dialog
    Application.Wait Now + TimeValue("00:00:02")
    Exit Sub
    '-------------------------------------------------------------------------
ErrorMessage1:
    ShowErrorMessage
End Sub

'================================================================================================
'- OPEN EXPLORER FOLDER - requires full folder path
'================================================================================================
Private Sub OPEN_FOLDER(Foldername As String)
    Dim Quote As String
    Dim ShellString As String
    Quote = Chr(34) ' quotation mark character = " in case spaces in folder name
    '---------------------------------------------------------------------------
    MacroPosition = "OPEN EXPLORER FOLDER"
    On Error GoTo ErrorMessage2
    '-
    WindowsFolder = GetSpecialfolder(CSIDL_WINDOWS)
    ShellString = WindowsFolder & "\explorer.exe " & Quote & Foldername & Quote
    RSP = Shell(ShellString, vbNormalFocus)
    Exit Sub
    '---------------------------------------------------------------------------
ErrorMessage2:
    ShowErrorMessage
End Sub

'===============================================================================================
'- FUNCTION TO GET WINDOWS EXPLORER FOLDER - called from Sub OPEN_FOLDER()
'===============================================================================================
Private Function GetSpecialfolder(CSIDL As Long) As String
    Dim r As Long
    Dim IDL As ITEMIDLIST
    '-------------------------------------------------------------
    MacroPosition = "GET WINDOWS EXPLORER FOLDER"
    On Error GoTo ErrorMessage3
    'Get the special folder
    r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If r = NOERROR Then
        path$ = Space$(512)
        'Get the path from the IDList
        r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path$)
        GetSpecialfolder = Left$(path, InStr(path, Chr$(0)) - 1)
        Exit Function
    End If
    GetSpecialfolder = ""
    Exit Function
    '-------------------------------------------------------------
ErrorMessage3:
    ShowErrorMessage
End Function
'--------------------------------------------------------------------------------
'================================================================================
'- SUBROUTINE - WAIT 1 SECOND
'================================================================================
Private Sub WAIT1()
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")
End Sub
'--------------------------------------------------------------------------------
'================================================================================
'- SUBROUTINE - ERROR MESSAGE & STOP MACRO
'================================================================================
Private Sub ShowErrorMessage()
    AppActivate Application.Caption     ' activate Excel
    ws.Activate
    MsgBox ("Error in macro section :-   " & MacroPosition)
    End
End Sub
'--------------------------------------------------------------------------------
'================================================================================
'- SUBROUTINE - CHECK FOR F10 KEY TO STOP MACRO
'================================================================================
Private Sub CHECK_F10_KEY()
    If GetKeyState(vbKeyF10) And MePressed Then
        MacroPosition = MacroPosition & vbCr & "Stopped by user F10 key"
        ShowErrorMessage
    End If
End Sub
'--------------------------------------------------------------------------------

 

[shippey121]

i tried your code brian i get a compile error at line

Dim ShellObj As Shell

the error is user defined type not defined

any ideas ??

sorry forgot to enable the Shell references

it does work now

 

[shippey121]

Now i got it to work i copied some of my music files to a test area after running the READ code i opened the directory and it listed all files and properties really quickly i applied a few formauls to split the Artist and track name and ran the write code, it changed all the items i had changed and seemed to work very well although the write part wasnt as quick as the reading part.

very good code although i dont understand it (still learning the basics), only thing i would change is the properties that are read, most people who change the track tags in my opinion would only change the Album,Artist and Track names so although it can read all properties very fast if the user could select which which they wanted to change first then maybe the write operation would be faster making this code very useful

just for your information Brian i use Tag & Rename to do this

 

[BrianB]

Thanks for your input. Glad to see you got it working.

 

[chefwarren]

Great Code... need help

I got the same shell error. But I figured that one out.

You have to go to tools, regerences, the Microsoft Shell Reference.

But now I got this error when trying to run the write code.

Dim MyClipData As DataObject 'Tools/References .... 'Microsoft Forms2 Object' Library

I dont see a reference for Microsoft Forms2 Object.

Can anyone help.

Warren

 

[galileogali]

Chefwarren,Try it
On the Projects Explorer
Thisworkbook>>Insert >>Userform

Now, run macro.....

GALILEOGALI

 

[chefwarren]

MOre help needed

help

hI,
Ok inserting the form got rid of my error message.

Now it runs through the macro which is crazy cause it like takes over my computer.. it ends by playing one of the songs in Windows Media. It says it made the changes, but when you look. There were no changes at all. And if you run the "read" Macro. It comes back with the same information as before you made any changes.

Can anyone help. two things
1. Why does it open Windows Media Player and start playing a song from the list. Can that be stopped.

2. How come the changes dont take effect.

Kindly,

Warren

 

[chefwarren]

bump