So there are a few questions about reading out there but none really properly answered it as to how one goes about taking a MP3 file of unknown characteristics and extracting the information about the bitrate(s) contained in the file, as well as how to find said frames in the file.
Some of the existing question which were similar in nature were answered with links to other websites that don't exists anymore. Or the content which was linked to no longer exists.
The closest I find is the technical documents over on http://www.mp3-tech.org/ with the guide for "MPEG Audio Layer I/II/III frame header" but then I also need to work around anything in the MP3 file which is not an audio frame so I seem to be needing information on locating that as well.
If you look for a VBA function you could use the Microsoft Shell Controls And Automation library
Function getBitrate(ByVal sPath As String) As Variant
' Reference to "Microsoft Shell Controls And Automation" is needed
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim objFolderItem As Shell32.FolderItem
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Left(sPath, InStrRev(sPath, "\") - 1))
Set objFolderItem = objFolder.ParseName(Mid(sPath, InStrRev(sPath, "\") + 1))
getBitrate = objFolder.GetDetailsOf(objFolderItem, 28)
End Function
Test it with
Sub Test()
Dim sPath As String
sPath = "d:\Music\filename.mp3"
Debug.Print "Bitrate: ", getBitrate(sPath)
End Sub
Further reading
Related
Having a question how can i get an external file title and tag information from properties window using VBA code?
I have tried to use this code in VBA:
Dim sFile As Variant
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim oDir: Set oDir = oShell.Namespace("C:\Users\vadis\Desktop\folderis\")
For Each strFileName In oDir.Items
For i = 0 To 134
MsgBox (oDir.GetDetailsOf(strFileName, i))
Next
Next
But it does not provide title and tag information of the file( gives only date_created and ownder info).
My file properties are here:
This seems so simple and I've had it working multiple times, but something keeps breaking between my Dir call (to iterate through a directory) and opening the current file. Here's the pertinent code:
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceCurrentFile)
What I get with this is a file access error as the Application.Workbooks.Open is trying to open "C:\ExcelWIP\TestSource\\FILENAME" (note extra slash)
However when I take the final slash out of SourceLoc, the results of Dir(SourceLoc) are "" (it doesn't search the directory).
The frustrating thing is that as I've edited the sub in other ways, the functionality of this code has come and gone. I've had it work as-is, and I've had taking the '/' out of the directory path make it work, and at the moment, I just can't get these to work right together.
I've scoured online help and ms articles but nothing seems to point to a reason why this would keep going up and down (without being edited except for when it stops working) and why the format of the directory path will sometimes work with the final '/' and sometimes without.
any ideas?
This would open all .xlxs files in that directory son.
Sub OpenFiles()
Dim SourceCurrentFile As String
Dim FileExtension as String: FileExtension = "*.xlxs"
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
SourceCurrentFile = Dir()
'Start looping through directory
Do While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc &"\"& SourceCurrentFile)
SourceCurrentFile = Dir(FileExtension)
Loop
End Sub
JLILI Aman hit on the answer which was to take the results of Dir() as a string. Using that combined with the path on Application.Open allows for stable behaviors from the code.
New Code:
Dim SourceLoc as String
Dim SourceCurrentFile as String
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc & "/" & SourceCurrentFile)
I didn't include the recommended file extension because I'm dealing with xls, xlsx, and xlsm files all in one directory. This code opens all of them.
Warning - this code will set current file to each file in the directory including non-excel files. In my case, I'm only dealing with excel files so that's not a problem.
As to why this happens, it does not appear that Application.Open will accept the full object results of Dir(), so the return of Dir() needs to be a String. I didn't dig deeper into the why of it beyond that.
Consider using VBA's FileSystemObject which includes the folder and file property:
Sub xlFilesOpen()
Dim strPath As String
Dim objFSO As Object, objFolder As Object, xlFile As Object
strPath = "C:\ExcelWIP\TestSource"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
For Each xlFile In objFolder.Files
If Right(xlFile, 4) = "xlsx" Or Right(xlFile, 3) = "xls" Then
Application.Workbooks.Open (xlFile)
End If
Next xlFile
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
i currently have this code in one of the macros for work. It is located under a button for browsing which folder to look into, and it will get the .DGNs and add them to a listbox.
I don't quite understand the code fully was hoping someone can give me a quick run down. Also, the code only looks at the selected folder for .DGNs, i want it to look into sub folders as well, is that possible?
Dim myFSO As New Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim myShell As New Shell32.Shell
Dim myRootFolder As Shell32.Folder3
Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
If myRootFolder Is Nothing Then Exit Sub
Set myFolder = myFSO.GetFolder(myRootFolder.Self.path)
txtCurrentFolder.Text = myRootFolder.Self.path
lstFilesInFolder.Clear
For Each myFile In myFolder.Files
Select Case UCase(Right(myFile.Name, 3))
Case "DGN"
If IsFileIn(myFile.path, lstFilesToProcess) = False Then
lstFilesInFolder.AddItem myFile.path
End If
End Select
Next
The code shows a GUI to select a folder, then iterates through the folder's child files testing if their names end in DGN and if so then testing if the file is already in some collection (lstFilesInFolder) and if not then adding it.
I think the approach seems a little complicated (picking a folder(s) can be done simply without using the Shell through Application.FileDialog) and I cannot judge some parts (like is it necessary to test lstFilesInFolder etc) without the rest of the code, and just personally I dislike the use of myX as a variable naming convention. Nevertheless, it does what it seems it is meant to do.
I like a stack/queue based approach to 'recursion' rather than actual recursive calls.
An example of converting your code to something that looks in subfolders as well is: (see comments on my added lines)
Dim myFSO As Scripting.FileSystemObject 'changed from late-binding
Set myFSO = New Scripting.FileSystemObject
Dim folderQueue As Collection 'queue
Set folderQueue = New Collection 'instantiate
Dim myFolder As Scripting.Folder
Dim subfolder As Scripting.Folder 'var for enumerating subfolders
Dim myFile As Scripting.File
Dim myShell As New Shell32.Shell
Dim myRootFolder As Shell32.Folder3
Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
If myRootFolder Is Nothing Then Exit Sub
folderQueue.Add myFSO.GetFolder(myRootFolder.Self.path) 'enqueue
Do While folderQueue.Count > 0 ''recursive' loop
Set myFolder = folderQueue(1) 'get next folder
folderQueue.Remove 1 'dequeue
txtCurrentFolder.Text = myRootFolder.Self.path
lstFilesInFolder.Clear
For Each subfolder in myFolder.SubFolders 'loop through subfolders adding for processing
folderQueue.Add subfolder 'enqueue
Next
For Each myFile In myFolder.Files
Select Case UCase(Right(myFile.Name, 3))
Case "DGN"
If IsFileIn(myFile.path, lstFilesToProcess) = False Then
lstFilesInFolder.AddItem myFile.path
End If
End Select
Next
Loop
As a final point, it is sometimes considered good practice to switch the use of a reference to a specific version of the Scripting library (nice for static typing) to using e.g. CreateObject("Scripting.FileSystemObject") before releasing to other users as the use of a reference can sometimes cause issues.
I am a professor in an English department, and my composition students often write multiple drafts of their essays. I use Word 2010 to track their changes.
I discovered VBA code on another site (located here). I created a new macro. It prompts me correctly for the base, new, and comparison folders, but the output is null.
I have the files in both the base and new folders named identically and saved in .doc format. I also set the trust center options in Word to 1) enable all macros and 2) trust access to the VBA project object model.
Sub CompareAllFiles()
Dim strFolderA As String
Dim strFolderB As String
Dim strFolderC As String
Dim strFileSpec As String
Dim strFileName As String
Dim objDocA As Word.Document
Dim objDocB As Word.Document
Dim objDocC As Word.Document
strFolderA = InputBox("Enter path to base documents:")
strFolderB = InputBox("Enter path to new documents:")
strFolderC = InputBox("Enter path for document comparisons to be saved:")
strFileSpec = "*.doc"
strFileName = Dir(strFolderA & strFileSpec)
Do While strFileName <> vbNullString
Set objDocA = Documents.Open(strFolderA & strFileName)
Set objDocB = Documents.Open(strFolderB & strFileName)
Application.CompareDocuments _
OriginalDocument:=objDocA, _
RevisedDocument:=objDocB, _
Destination:=wdCompareDestinationNew
objDocA.Close
objDocB.Close
Set objDocC = ActiveDocument
objDocC.SaveAs FileName:=strFolderC & strFileName
objDocC.Close SaveChanges:=False
strFileName = Dir
Loop
Set objDocA = Nothing
Set objDocB = Nothing
End Sub
If you and your students are using Word 2010 then the extension would most likely be .docx:
strFileSpec = "*.docx"
Have you tried running the code step-by-step with the VBA debugger, to see what is the exact point of failure? See here (under the section entitled Stepping Through Code) for a simple introduction.
Some kind VBA guru figured it out for me: I need to enter a \ at the end of the folder paths. Without the final backslash, the script was not able to locate the folders, and thus it wasn't processing any files. After adding the final \ to all three folder paths, the code ran perfectly.
As a bonus, the code processes both .doc and .docx files. I thought I was going to have to convert all my .docx files to .doc before processing, but the code is smarter than that.
Eureka!
Trying to use Excel VBA to capture all the file attributes from files on disk, including extended attributes. Was able to get it to loop through the files and capture the basic attributes (that come from the file system):
File Path
File Name
File Size
Date Created
Date Last Accessed
Date Last Modified
File Type
Would also like to capture the extended properties that come from the file itself:
Author
Keywords
Comments
Last Author
Category
Subject
And other properties which are visible when right clicking on the file.
The goal is to create a detailed list of all the files on a file server.
You say loop .. so if you want to do this for a dir instead of the current document;
Dim sFile As Variant
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim oDir: Set oDir = oShell.Namespace("c:\foo")
For Each sFile In oDir.Items
Debug.Print oDir.GetDetailsOf(sFile, XXX)
Next
Where XXX is an attribute column index, 9 for Author for example.
To list available indexes for your reference you can replace the for loop with;
for i = 0 To 40
debug.? i, oDir.GetDetailsOf(oDir.Items, i)
Next
Quickly for a single file/attribute:
Const PROP_COMPUTER As Long = 56
With CreateObject("Shell.Application").Namespace("C:\HOSTDIRECTORY")
MsgBox .GetDetailsOf(.Items.Item("FILE.NAME"), PROP_COMPUTER)
End With
You can get this with .BuiltInDocmementProperties.
For example:
Public Sub PrintDocumentProperties()
Dim oApp As New Excel.Application
Dim oWB As Workbook
Set oWB = ActiveWorkbook
Dim title As String
title = oWB.BuiltinDocumentProperties("Title")
Dim lastauthor As String
lastauthor = oWB.BuiltinDocumentProperties("Last Author")
Debug.Print title
Debug.Print lastauthor
End Sub
See this page for all the fields you can access with this: http://msdn.microsoft.com/en-us/library/bb220896.aspx
If you're trying to do this outside of the client (i.e. with Excel closed and running code from, say, a .NET program), you need to use DSOFile.dll.
'vb.net
'Extended file stributes
'visual basic .net sample
Dim sFile As Object
Dim oShell = CreateObject("Shell.Application")
Dim oDir = oShell.Namespace("c:\temp")
For i = 0 To 34
TextBox1.Text = TextBox1.Text & oDir.GetDetailsOf(oDir, i) & vbCrLf
For Each sFile In oDir.Items
TextBox1.Text = TextBox1.Text & oDir.GetDetailsOf(sFile, i) & vbCrLf
Next
TextBox1.Text = TextBox1.Text & vbCrLf
Next
I was finally able to get this to work for my needs.
The old voted up code does not run on windows 10 system (at least not mine). The referenced MS library link below provides current examples on how to make this work. My example uses them with late bindings.
https://learn.microsoft.com/en-us/windows/win32/shell/folder-getdetailsof.
The attribute codes were different on my computer and like someone mentioned above most return blank values even if they are not. I used a for loop to cycle through all of them and found out that Title and Subject can still be accessed which is more then enough for my purposes.
Private Sub MySubNamek()
Dim objShell As Object 'Shell
Dim objFolder As Object 'Folder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("E:\MyFolder")
If (Not objFolder Is Nothing) Then
Dim objFolderItem As Object 'FolderItem
Set objFolderItem = objFolder.ParseName("Myfilename.txt")
For i = 0 To 288
szItem = objFolder.GetDetailsOf(objFolderItem, i)
Debug.Print i & " - " & szItem
Next
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
Lucky discovery
if objFolderItem is Nothing when you call
objFolder.GetDetailsOf(objFolderItem, i)
the string returned is the name of the property, rather than its (undefined) value
e.g. when i=3 it returns "Date modified"
Doing it for all 288 values of I makes it clear why most cause it to return blank for most filetypes
e.g i=175 is "Horizontal resolution"