Pull File info only from subfolders till 3 levels-CodePudding

I have a standalone VB script that will get all the file information from a given address path and write them in a excel. It can access all the subfolders and their file information too. I don't want to access all the levels of the subfolders. I want only 3 levels of subfolders information.


Const BIF_returnonlyfsdirs   = &H0001
Const BIF_dontgobelowdomain  = &H0002
Const BIF_statustext         = &H0004
Const BIF_returnfsancestors  = &H0008
Const BIF_editbox            = &H0010
Const BIF_validate           = &H0020
Const BIF_browseforcomputer  = &H1000
Const BIF_browseforprinter   = &H2000
Const BIF_browseincludefiles = &H4000

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDlg = WScript.CreateObject("Shell.Application")
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")

'Get the Source Folder
' Use the BrowseForFolder method.
Set objStartFolder = objDlg.namespace("\\bodsproduction\Staging_BODS\Scripts")

' Here we use TypeName to detect the result.
If InStr(1, TypeName(objStartFolder), "Folder") > 0 Then
    sourceFolder = objStartFolder.ParentFolder.ParseName(objStartFolder.Title).Path
Else
    MsgBox "An Error has occured: Unable To read destination folder"
End If

currentScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
reportFile = currentScriptPath & "File_Report.csv"

'OpenTextFile(destination, forwriting, createnew, open as Unicode)
Set objReportFile = objFSO.OpenTextFile(reportFile, ForWriting, True)

'Add headers
objReportFile.Writeline "File_Full_Path, File_Name, Created_By, Created_On, Modified_On, File_Size, Type"

'Run though file report process
ReportFiles sourceFolder

'Close the file
objReportFile.Close

Function ReportFiles(currentFolder)
    Dim objFolder, objFile, fileCollection, folderCollection, subFolder
    
    Set objFolder = objFSO.GetFolder(currentFolder)
    'MsgBox currentFolder
    Set fileCollection = objFolder.Files
    
    For Each objFile In fileCollection
        'MsgBox objFile.Name
        'Get File Properties
        strFilePath = objFile.Path
        strFileName = objFile.Name
        strFileSize = objFile.Size / 1024
        strFileType = objFile.Type
        strFileDateCreated = objFile.DateCreated
        strFileDateLastAccessed = objFile.DateLastAccessed
        strFileDateLastModified = objFile.DateLastModified
        
        'Get File owner
        strFileOwnerDomain = ""
        strFileOwner = ""
        
        on Error Resume Next
        strComputer = "."
        Set objWMIService = GetObject("winmgmtQ:" _
          & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        
        If strFileType <> "Shortcut" Or InStr(1,strFileName, "AlbumArt",1) = 0 Or InStr(1,strFileName, "£",1) Then
            Set colItems = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting=""" & Replace(strFilePath, "\", "\\") & """}" & " WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")
            
            For Each objItem in colItems
                strFileOwnerDomain =  objItem.ReferencedDomainName
                strFileOwner = objItem.AccountName
            Next
        End If
        
        strOwner = strFileOwnerDomain & "\" & strFileOwner
        
        if strFileOwner = "" Then
        strOwner = ""
    End If
    
    objReportFile.Writeline (replace(strFilePath,"Q:","\\bodsproduction\Staging_BODS\") & "," _
                          & strFileName & "," _
                          & strOwner & "," _
                          & formatDateTime(strFileDateCreated,2) & " " & right("0" & hour(strFileDateCreated),2) & ":" & right("0" & minute(strFileDateCreated),2) & ":" & right("0" & second(strFileDateCreated),2) & "," _
                          & formatDateTime(strFileDateLastModified,2) & " " & right("0" & hour(strFileDateLastModified),2) & ":" & right("0" & minute(strFileDateLastModified),2) & ":" & right("0" & second(strFileDateLastModified),2) & "," _
                          & Round(strFileSize,2) & "," _
                          & strFileType)
Next

'Loop for each sub folder
Set folderCollection = objFolder.SubFolders

For Each subFolder In folderCollection
    ReportFiles subFolder.Path
Next
End Function

objNetwork.RemoveNetworkDrive "Q:", True, TRUE

From the above image you can see the details of files in the subfolders. I want to access only till the lib folder. I don't want to access bods_buddy folder.

Same here I want to access only till bin folder. Is there a way to achieve this.

I saw a similar question like this but it didn't help me in anyway. File info pull from sub folders only 2-3 levels deep

CodePudding user response：

So as to make it a little easier for me to debug, I wrote a function that will work in Excel VBA that you can paste in, it should still also work in VBScript directly, you may just need to fix up the lines that don't quite translate.

Dim objFSO

Public Sub GetFilesInFolders()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    DoGetFilesInFolders "c:\temp\Root", 3
    
    Set objFSO = Nothing
End Sub

Private Sub DoGetFilesInFolders(ByVal strPath, ByVal lngLevelsDeep, _
        Optional ByVal lngCurrentLevel = 0)
    
    Dim objRootFolder, objFolder, objFile
    
    Set objRootFolder = objFSO.GetFolder(strPath)
    
    lngCurrentLevel = lngCurrentLevel   1
    
    If lngCurrentLevel <= lngLevelsDeep Then
        For Each objFolder In objRootFolder.SubFolders
            DoGetFilesInFolders objFolder.Path, lngLevelsDeep, lngCurrentLevel
        Next
    End If
    
    For Each objFile In objRootFolder.Files
        Debug.Print objFile.Path
    Next
End Sub

Basically though, you need a recursive function that will store all files into some sort of an array/dictionary down to the level you want it to.

The above simply spits the filename out to the immediate window in Excel but you can adapt as need be.

Naturally, amending your script in its entirety is not really possible for me so I broke it down to the easiest example of a recursive function that you ultimately need.

I was working off folder c:\temp\Root to prove the concept.