仅从子文件夹中提取文件信息直到 3 级

Question

我有一个独立的 VB 脚本，它将从给定的地址路径获取所有文件信息并将它们写入 excel。它也可以访问所有子文件夹及其文件信息。我不想访问所有级别的子文件夹。我只想要 3 级子文件夹信息。


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

从上图中您可以看到子文件夹中文件的详细信息。我只想访问 lib 文件夹。我不想访问 bods_buddy 文件夹。

同样在这里我只想访问 bin 文件夹。有没有办法实现这个。

我看到了类似的问题，但无论如何都没有帮助我。

Answer 1

为了让我更容易调试，我写了一个可以在 Excel VBA 中运行的函数，你可以粘贴进去，它应该也可以直接在 VBScript 中运行，您可能只需要修复未完全翻译的行。

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

但基本上，您需要一个递归函数，将所有文件存储到某种 array/dictionary 中，直至达到您想要的级别。

上面只是将文件名输出到 Excel 中的直接 window，但您可以根据需要进行调整。

当然，对我来说，完全修改您的脚本是不可能的，因此我将其分解为您最终需要的最简单的递归函数示例。

我正在处理文件夹 c:\temp\Root 来证明这个概念。

仅从子文件夹中提取文件信息直到 3 级

Pull File info only from subfolders till 3 levels

excel

vba

subdirectory