#1
|
|||
|
|||
Is it possible to extract mp3's start time and end time by VBA?
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. |
#2
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
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) |
#4
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
Quote:
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 Last edited by syl3786; 02-12-2023 at 08:32 AM. Reason: change the formatting |
|
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 |