Is it possible to extract mp3's start time and end time by VBA?

syl3786 · #1 02-09-2023, 09:18 AM

Hi Community,

I am investigating on how to extract mp3's start time and end time by VBA.

For example:

Sub test()

Selection.InlineShapes.AddOLEObject ClassType:="Package", FileName:= _
"D:\users\123.mp3" _
, LinkToFile:=True, DisplayAsIcon:=False

End Sub

This macro can only insert the mp3 to the word file. I searched many forums but in vain. There seem no similar macros to extract the mp3 file's start time and end time to word processor. Is it possible to extract a lot of mp3files' start time and end time in the Microsoft Word by VBA?

Your help would be greatly appreciated.

gmayor · #2 02-09-2023, 10:26 PM

You can read the metadata using the code below. However the start time will surely always be 0 and the metadata will give you the length of the mp3. I have left in the code that will read the rest of the metadata should you need it.

Code:

Option Explicit

Sub Test()
'Based on code from
'https://stackoverflow.com/questions/54152307/how-do-i-read-the-metadata-information-from-a-closed-workbook-using-excel-vba
Dim oDetails, sName

    Set oDetails = GetDetails("D:\Sound Data\Pink Floyd - Complete collection\Pink Floyd [1995] - Pulse (Live)\Pink Floyd - 23 - Comfortably Numb.mp3")
    'If oDetails.Exists("Tags") Then Debug.Print oDetails("Tags")
    'If oDetails.Exists("Title") Then Debug.Print oDetails("Title")
    'Debug.Print String(40, "-")
    For Each sName In oDetails
Debug.Print sName & " = " & oDetails(sName)
    Next

End Sub

Function GetDetails(sPath)

    Dim sFolderName, sFileName, oShell, oFolder, oFile, oDetails, i, sName, sValue

    SplitFullPath sPath, sFolderName, sFileName
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace(sFolderName)
    Set oFile = oFolder.ParseName(sFileName)
    Set oDetails = CreateObject("Scripting.Dictionary")
    'For i = 0 To 511
        'sName = oFolder.GetDetailsOf(oFolder.Items, i)
        'sValue = oFolder.GetDetailsOf(oFile, i)
        sName = oFolder.GetDetailsOf(oFolder.Items, 27) '27 is the length
        sValue = oFolder.GetDetailsOf(oFile, 27)
        If sName <> "" And sValue <> "" Then oDetails(sName) = sValue
    'Next
    Set GetDetails = oDetails

End Function

Sub SplitFullPath(sPath, sFolderName, sFileName)

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(sPath) Then Exit Sub
        sFolderName = .GetParentFoldername(sPath)
        sFileName = .GetFileName(sPath)
    End With

End Sub

syl3786 · #3 02-09-2023, 11:25 PM

Thank you gmayor.

I copied and pasted the above code into Microsoft Word's VBA by Alt+ F11. Then I copied the path of the .mp3 placed on the desktop to the code. After I run the code, there is no start time and end time shown in the Word processor.

And I have another question:

Can the macro read and output the .m4a file's start time and end time, if the .m4a file's start and end time is according to the time of recording? (For example, the start time and end time of a .m4a file is 11:00:00 am to 13:00:00 pm, not 00:00:00 - 02:00:00)

gmayor · #4 02-10-2023, 01:58 AM

The code writes to the immediate window. If you want to write it to the document cursor position change Debug.print to Selection.Text =
If you restore the commented out items as shown below, you can list all the available metadata, which will depend on file type. See for yourself if it includes the required data. The numbers at the ends of the rows are the codes associated with each entry (as opposed to the 27 in the previous code)

Code:

Option Explicit

Sub Test()
'Based on code from
'https://stackoverflow.com/questions/54152307/how-do-i-read-the-metadata-information-from-a-closed-workbook-using-excel-vba
Dim oDetails, sName

    Set oDetails = GetDetails("D:\Sound Data\Pink Floyd - Complete collection\Pink Floyd [1995] - Pulse (Live)\Pink Floyd - 23 - Comfortably Numb.mp3")
    For Each sName In oDetails
        Selection.TypeText sName & " = " & oDetails(sName)
    Next

End Sub

Function GetDetails(sPath)

    Dim sFolderName, sFileName, oShell, oFolder, oFile, oDetails, i, sName, sValue

    SplitFullPath sPath, sFolderName, sFileName
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace(sFolderName)
    Set oFile = oFolder.ParseName(sFileName)
    Set oDetails = CreateObject("Scripting.Dictionary")
    For i = 0 To 511
        sName = oFolder.GetDetailsOf(oFolder.Items, i)
        sValue = oFolder.GetDetailsOf(oFile, i)
        If sName <> "" And sValue <> "" Then oDetails(sName) = sValue & " - " & i & vbCr
        DoEvents
    Next
    Set GetDetails = oDetails

End Function

Sub SplitFullPath(sPath, sFolderName, sFileName)

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(sPath) Then Exit Sub
        sFolderName = .GetParentFoldername(sPath)
        sFileName = .GetFileName(sPath)
    End With

End Sub

syl3786 · #5 02-12-2023, 08:30 AM

Quote:

Originally Posted by gmayor

The code writes to the immediate window. If you want to write it to the document cursor position change Debug.print to Selection.Text =
If you restore the commented out items as shown below, you can list all the available metadata, which will depend on file type. See for yourself if it includes the required data. The numbers at the ends of the rows are the codes associated with each entry (as opposed to the 27 in the previous code)

Code:

Option Explicit

Sub Test()
'Based on code from
'https://stackoverflow.com/questions/54152307/how-do-i-read-the-metadata-information-from-a-closed-workbook-using-excel-vba
Dim oDetails, sName

    Set oDetails = GetDetails("D:\Sound Data\Pink Floyd - Complete collection\Pink Floyd [1995] - Pulse (Live)\Pink Floyd - 23 - Comfortably Numb.mp3")
    For Each sName In oDetails
        Selection.TypeText sName & " = " & oDetails(sName)
    Next

End Sub

Function GetDetails(sPath)

    Dim sFolderName, sFileName, oShell, oFolder, oFile, oDetails, i, sName, sValue

    SplitFullPath sPath, sFolderName, sFileName
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace(sFolderName)
    Set oFile = oFolder.ParseName(sFileName)
    Set oDetails = CreateObject("Scripting.Dictionary")
    For i = 0 To 511
        sName = oFolder.GetDetailsOf(oFolder.Items, i)
        sValue = oFolder.GetDetailsOf(oFile, i)
        If sName <> "" And sValue <> "" Then oDetails(sName) = sValue & " - " & i & vbCr
        DoEvents
    Next
    Set GetDetails = oDetails

End Function

Sub SplitFullPath(sPath, sFolderName, sFileName)

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(sPath) Then Exit Sub
        sFolderName = .GetParentFoldername(sPath)
        sFileName = .GetFileName(sPath)
    End With

End Sub

Thank you! It works well. May I ask if it can complete the following tasks:

1. press the macro button, then came out a msg box asking the path of a folder (the folder should contain some .mp3 or .dcr or .m4a files).

2 After pasted the path to it and press "enter", the macro will read the audio files' properties (e.g., read and write the first five and 377 (0, 1, 2, 3, 377, 378, 379) and list out the specific properties as wrote in the code.

For example, I found a macro (for Excel) that can get MetaData from sound files:
But then I need another macro to copy these data from Excel to a new document. After that, I need to copy it from the new document again to my designated document.

Code:

Sub GetMetaDataFromSoundFiles()

    Dim objShellApp As Object
    Dim objFolder As Object
    Dim varColumns As Variant
    Dim arrData() As Variant
    Dim strFilename As String
    Dim fileCount As Long
    Dim i As Long
    Dim j As Long
    
    Set objShellApp = CreateObject("Shell.Application")
    Set objFolder = objShellApp.Namespace("PUT THE FOLDER's PATH HERE") 'change the path to the source folder accordingly
    
    varColumns = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)

    
    ReDim arrData(0 To UBound(varColumns), 0 To objFolder.Items.Count)
    
    For i = LBound(arrData, 1) To UBound(arrData, 1)
        arrData(i, 0) = objFolder.GetDetailsOf(objFolder.Items, varColumns(i))
    Next i
    
    fileCount = 0
    For i = 0 To objFolder.Items.Count - 1
        strFilename = objFolder.GetDetailsOf(objFolder.Items.Item(CLng(i)), 0)
        If Right(strFilename, 4) = ".dcr" Or Right(strFilename, 4) = ".wma" Then
            fileCount = fileCount + 1
            For j = 0 To UBound(varColumns)
                arrData(j, fileCount) = objFolder.GetDetailsOf(objFolder.Items.Item(CLng(i)), varColumns(j))
            Next j
        End If
    Next i
    
    Worksheets.Add
    
    Range("A1").Resize(UBound(arrData, 2) + 1, UBound(arrData, 1) + 1).Value = Application.Transpose(arrData)
    
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Rounding Up or Down depending on Start & End time	richardst	Excel	4	06-21-2016 06:03 PM
Start & Finish Date/Time	rtuttle	Project	9	04-15-2016 06:18 AM
find shift with start and end time	Haha88	Excel	1	10-13-2015 11:30 PM
Extract data from web - Take a long time	edneco	Excel Programming	11	06-28-2014 05:54 PM
Increase length of Start time drop down list	laguna92651	Outlook	0	07-11-2013 12:23 PM