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