在目录中搜索文件并列出它们的名称和路径 - 两个级别的子文件夹

Posted 2023-04-19

【中文标题】在目录中搜索文件并列出它们的名称和路径 - 两个级别的子文件夹

【英文标题】：Searching directory for files and listing their name and path - two levels of subfolders

【发布时间】：2018-08-15 11:40:00

【问题描述】：

我目前正在尝试编辑另一个团队之前创建的宏 它能够非常成功地从特定位置检索所有文件名和路径，如果所有文件都在那里，这非常有用。

我的问题是我试图将其调整到文件保存在“存储”目录中的另一个区域 他们从这里出发：

Storage\ProposalFolder\（3 个文件夹中的 1 个）\文件

3 个文件夹中的 1 个有助于根据提案​​类型对它们进行排序

项目、前景或嫌疑人

所以我需要做的是有一个给定存储目录的宏，然后扫描每个提案子文件夹，然后查看文件存储在哪个文件夹类型中（如果文件在项目中，其他 2 个文件夹将是空）

请看下面

存储视图

提案文件夹

项目/前景/可疑文件夹

这是留下的代码 - 我在这里和那里编辑过它

Sub ListFilesInDirectory()

If MsgBox("Are you sure you want to list the files?", vbYesNo) = vbNo Then
End
Else
End If

Select Case MsgBox("Press Yes to retrieve ALL files." & vbNewLine & vbNewLine & "Press No to retrieve *** files only", vbQuestion + vbYesNoCancel + vbDefaultButton1, "Which Do You Want To Retrieve?")
Case vbCancel
End
Case vbNo
***_Option = 1
Case vbYes
***_Option = 2
End Select


Dim counter As Single
counter = Timer

On Error GoTo error_message
Application.StatusBar = "The macro is running. Please wait..."


Application.Calculation = xlCalculationManual
Range("A7:KZ10000").Select
Selection.ClearContents
Cells.FormatConditions.Delete
Range("A1").Select
Application.ScreenUpdating = False


'Populate columns A to C
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim objSubfolders As Object

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = ActiveSheet

    startrow = 7


    If IsEmpty(Range("file_directory")) Then
        GoTo skip_this
        Else
        filedir = Range("file_directory").Value
    End If


    'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder(filedir)
    Set objSubfolders = objFolder.subfolders
    'ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"

     'Loop through the Files collection
    If ***_Option = 1 Then
     For Each objFile In objFolder.Files
     DoEvents

      If InStr(UCase(objFile.Name), "****") > 0 Then
        ws.Cells(startrow, 1).Value = filedir
'        ws.Cells(startrow, 2).Value = "=HYPERLINK(" & Chr(34) & filedir & "\" & objFile.Name & Chr(34) & "," & Chr(34) & objFile.Name & Chr(34) & ")"
        ws.Cells(startrow, 2).Value = objFile.Name
        ws.Cells(startrow, 2).Hyperlinks.Add ws.Cells(startrow, 2), filedir & "\" & objFile.Name

        ws.Cells(startrow, 3).Value = objFile.DateLastModified
        startrow = startrow + 1
      End If
     Next
    End If

    If ***_Option = 2 Then
    For Each objFile In objFolder.Files
     DoEvents
        ws.Cells(startrow, 1).Value = filedir
'        ws.Cells(startrow, 2).Value = "=HYPERLINK(" & Chr(34) & filedir & "\" & objFile.Name & Chr(34) & "," & Chr(34) & objFile.Name & Chr(34) & ")"
        ws.Cells(startrow, 2).Value = objFile.Name
        ws.Cells(startrow, 2).Hyperlinks.Add ws.Cells(startrow, 2), filedir & "\" & objFile.Name
        ws.Cells(startrow, 3).Formula = "=CONCATENATE(" & startrow & "2," & startrow & "3)"
        startrow = startrow + 1
     Next

'    For Each SubFolder In objSubfolders
'
'     For Each objFile In objSubfolders.Files
'     DoEvents
'        ws.Cells(startrow, 1).Value = filedir
''        ws.Cells(startrow, 2).Value = "=HYPERLINK(" & Chr(34) & filedir & "\" & objFile.Name & Chr(34) & "," & Chr(34) & objFile.Name & Chr(34) & ")"
'        ws.Cells(startrow, 2).Value = objFile.Name
'        ws.Cells(startrow, 2).Hyperlinks.Add ws.Cells(startrow, 2), filedir & "\" & objFile.Name
'        ws.Cells(startrow, 3).Value = objFile.DateLastModified
'        startrow = startrow + 1
'     Next
'    Next SubFolder
    End If


'        For Each SubFolder In SourceFolder.subfolders
'            ListFilesInFolder SubFolder.Path, True
'        Next SubFolder
'
'    If subfolders = True Then
'        For Each SubFolder In SourceFolder.subfolders
'            ListFilesInFolder SubFolder.Path, True
'        Next SubFolder
'    End If

skip_this:
  Next

    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

    lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'Format any potential error files in red
    Cells.FormatConditions.Delete
    Range("B7:B" & lastrow).Select

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=RIGHT(B7,5)<>"".xlsm"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEFT(B7,1)=""~"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True


'Range("C4").Select
'ActiveCell.FormulaR1C1 = "Date" & Chr(10) & "Modified"

Range("C7:C" & lastrow).Select
Selection.NumberFormat = "dd/mm/yyyy  hh:mm:ss"
Selection.HorizontalAlignment = xlCenter

Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False

MsgBox ("Time taken to list files (hr:min:sec): " & Format((Timer - counter) / 86400, "hh:mm:ss") & vbNewLine & vbNewLine & "Please now do an initial cleanup of the files listed:" & vbNewLine & "  1) Delete any obvious older versions of the files" & vbNewLine & "  2) Files highlighted red are likely to be incorrect and should be deleted")

Exit Sub
error_message:
If Err.Number <> 0 Then
     Msg = "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
     MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
     End If
Range("A7:KZ10000").Select
Selection.ClearContents
Cells.FormatConditions.Delete
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox ("You have entered an incorrect directory path. Please ensure the 3 cells in the Variables tab are showing valid directory paths, or the cells are empty")
End Sub

我需要做的是列出子文件夹中的文件，就像“对于每个 objFile”代码所做的那样，但我无法理解如何进一步超越一级子文件夹 - 注释掉的代码关于子文件夹是我：/

任何帮助都会很棒！

【问题讨论】：

确认一下，您只需要递归地列出文件夹中的文件（因此它包括子文件夹）是否正确？

我这么认为？但我不知道如何递归调用 - 我见过其他人这样做，但我自己不明白，

要查找子文件夹（或任何分层子集），您需要使用 recursion（在本例中为 self-referring procedure .) 有一个自引用循环的示例here。

【参考方案1】：

再上面的cmets...

递归过程通常通过调用自身重复到“较低级别”。显然，如果编码不正确，这可能会导致问题，但本网站和其他网站上有无数的代码示例，例如：

堆栈溢出：

List all files in a folder and subfolders in excel

堆栈溢出：

Loop through files in a folder using VBA?

堆栈溢出：

get list of subdirs in vba

堆栈溢出：

List files in folder and subfolder with path to .txt file

艾伦·布朗：

List files recursively

奇普·皮尔森：

Recursion And The FileSystemObject

***：

Recursion in Computer Science

您需要知道的一切都包含在这些页面中（或链接自这些页面）。

【讨论】：

谢谢老兄-我会检查出来

递归过程有时也称为自引用。在here 上有一个自引用循环的示例。