How can I get file details in subfolders recursively?

Question

I'm trying to compile a list of specific details about the music files on my computer, but my knowledge of VBS is limited. (Actually, I've done some VBA, but no VBS before.) I found two scripts online: one gets the file details in a folder and the other lists the names of subfolders and files recursively. I'm trying to combine the two but I'm running into problems because the first script starts with CreateObject("Shell.Application") and the second starts with CreateObject("Scripting.FileSystemObject"). This (i.e., Shell vs. FSO) is one of the areas of VBS scripting about which my knowledge is lacking, to put it mildly.

The incompatibility in my script appears in the For Each objFile in colFiles loop, which I inserted from the "Shell script" I referred to above. What can I do to make this script work?

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim StartFolder, FileName, fso, MyFile, Tabs, arrDetails(4)

Tabs = ""

arrDetails(0) = 0
arrDetails(1) = 1
arrDetails(2) = 27
arrDetails(3) = 28

StartFolder = "C:\Users\user\Music\MP3s"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(StartFolder)

FileName = "C:\Users\user\Documents\MP3 File Details.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.OpenTextFile(FileName, ForAppending, True, True)

MyFile.WriteLine objFolder.Path

ShowSubfolders objFSO.GetFolder(StartFolder), Tabs, arrDetails


Sub ShowSubFolders(Folder, ByVal Tabs, arrDetails)
  Dim TabsFolder, TabsFiles, FileLine, arrText(4), i, d

  TabsFolder = Tabs & "" & vbtab & ""

  For Each Subfolder in Folder.SubFolders
    MyFile.WriteLine
    MyFile.WriteLine TabsFolder & Subfolder.Name

    TabsFiles = TabsFolder & "" & vbtab & ""

    Set objSubFolder = objFSO.GetFolder(Subfolder.Path)
    Set colFiles = objSubFolder.Files

    'Original inserted code for getting file details
'    For Each strFileName in objFolder.Items
'      For i = 0 to 3
'        d = arrDetails(i)
'        arrText(i) = objFolder.GetDetailsOf(strFileName, d)
'      Next
'    
'      FileLine = arrText(0)
'      For i = 1 to 3
'        FileLine = FileLine & vbtab & arrText(i)
'      Next
'      MyFile.WriteLine FileLine
'    Next

    'Attempt to make code compatible with rest of script
    For Each objFile in colFiles
      If LCase(InStr(1, objFile.Name, ".mp3")) > 1 then
        For i = 0 to 3
          d = arrDetails(i)
          arrText(i) = colFiles.GetDetailsOf(objFile, d)
        Next

        FileLine = arrText(0)
        For i = 1 to 3
          FileLine = FileLine & vbtab & arrText(i)
        Next

        MyFile.WriteLine TabsFiles & FileLine
      End If
    Next

    ShowSubFolders Subfolder, TabsFolder, arrDetails
  Next
End Sub

MyFile.Close

Haven't studied you code, but something I spotted is that you need to reverse LCase and InStr — Rno
@Arno You're right. I should have noticed that. That's what I get for copying something off the internet without checking it thoroughly. — gr8dane

Étienne Laneville Étienne Laneville · Accepted Answer · 2020-09-26T21:28:42

You do need both the FileSystemObject and the Windows Shell object in this case. You use the FileSystemObject to loop through the folders. In each folder, you then use the Windows Shell object to get the file details.

Here's a modified ShowSubFolders Sub that will work as expected:

Sub ShowSubFolders(Folder, Tabs, arrDetails)
    Dim TabsFolder, TabsFiles, FileLine, arrText(4), i, d
    Dim objShell
    Dim objFolder
    Dim objSubfolder
    Dim objFiles
    Dim objFile
    Dim sFileName
    
    Set objShell = CreateObject("Shell.Application")

    TabsFolder = Tabs & "" & vbTab & ""
    
    For Each objSubfolder In Folder.SubFolders
    
        ' Write subfolder to file
        MyFile.WriteLine
        MyFile.WriteLine TabsFolder & objSubfolder.Name
        
        ' Increment tab position
        TabsFiles = TabsFolder & "" & vbTab & ""
        
        Set objFolder = objShell.Namespace(objSubfolder.Path)
        Set objFiles = objSubfolder.Files
        
        For Each sFileName In objFolder.Items
            
            ' Check if file is MP3
            If InStr(1, LCase(sFileName), ".mp3") > 0 Then
            
                ' Get file details
                For i = 0 To 3
                    d = arrDetails(i)
                    arrText(i) = objFolder.GetDetailsOf(sFileName, d)
                Next
                
                ' Build file information line
                FileLine = arrText(0)
                For i = 1 To 3
                    FileLine = FileLine & vbTab & arrText(i)
                Next
                
                ' Write file information to file
                MyFile.WriteLine TabsFiles & FileLine
            
            End If
            
        Next
        
        ' Call recursively to handle subfolders
        ShowSubFolders objSubfolder, TabsFolder, arrDetails
  
    Next

End Sub

The code you had commented out was good and made accessing extended file properties (like length and bitrate in your case) possible using the arrDetails you have.

Also included in this revised sub is the fix Arno Van Boven mentioned in the comments regarding flipping InStr and LCase.

How can I get file details in subfolders recursively?

1 Answers