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

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