Извлекать информацию о файле только из подпапок до 3 уровней

У меня есть автономный сценарий 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

enter image description here

На изображении выше вы можете увидеть подробную информацию о файлах в подпапках. Я хочу получить доступ только до папки библиотека. Я не хочу получать доступ к папке bods_buddy.

enter image description here Здесь же я хочу получить доступ только до папки мусорное ведро. Есть ли способ добиться этого.

Я видел подобный вопрос, как этот, но это мне все равно не помогло. Информация о файлах извлекается из подпапок глубиной всего 2-3 уровня.

3 метода стилизации элементов HTML
3 метода стилизации элементов HTML
Когда дело доходит до применения какого-либо стиля к нашему HTML, существует три подхода: встроенный, внутренний и внешний. Предпочтительным обычно...
Формы c голосовым вводом в React с помощью Speechly
Формы c голосовым вводом в React с помощью Speechly
Пытались ли вы когда-нибудь заполнить веб-форму в области электронной коммерции, которая требует много кликов и выбора? Вас попросят заполнить дату,...
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Будучи разработчиком веб-приложений, легко впасть в заблуждение, считая, что приложение без JavaScript не имеет права на жизнь. Нам становится удобно...
Flatpickr: простой модуль календаря для вашего приложения на React
Flatpickr: простой модуль календаря для вашего приложения на React
Если вы ищете пакет для быстрой интеграции календаря с выбором даты в ваше приложения, то библиотека Flatpickr отлично справится с этой задачей....
В чем разница между Promise и Observable?
В чем разница между Promise и Observable?
Разберитесь в этом вопросе, и вы значительно повысите уровень своей компетенции.
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Клиент для URL-адресов, cURL, позволяет взаимодействовать с множеством различных серверов по множеству различных протоколов с синтаксисом URL.
0
0
51
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 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

По сути, вам нужна рекурсивная функция, которая будет хранить все файлы в каком-то массиве/словаре до нужного вам уровня.

Приведенное выше просто выводит имя файла в ближайшее окно Excel, но вы можете адаптировать его по мере необходимости.

Естественно, изменение вашего сценария полностью для меня не представляется возможным, поэтому я разбил его на самый простой пример рекурсивной функции, который вам в конечном итоге понадобится.

Я работал над папкой c:\temp\корень, чтобы проверить концепцию.

Другие вопросы по теме