Question

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

我的问题是我正在尝试使其适应文件存储在“存储”目录中的另一个区域他们从这里出发：

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

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

项目，前景或怀疑

所以我需要做的是给存储目录指定一个宏，然后在每个Proposal子文件夹中进行扫描，然后查看该文件所存储的文件夹类型（如果该文件位于Project中，则其他两个文件夹将是空）

请参阅下文

存储视图

投标文件夹

Project / prospect / suspect文件夹

这是留下的代码-我在这里和那里都对其进行了编辑

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

我需要做的是像“ For each objFile”代码一样列出子文件夹中的文件，但是我无法直言不讳地介绍了一层子文件夹，因为注释掉了有关子文件夹的代码是我：/

任何帮助都会超级棒！

Answer 1

进一步上面的评论...

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

堆栈溢出： 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

艾伦·布朗（Allen Browne）：List files recursively

Chip Pearson：Recursion And The FileSystemObject

维基百科：Recursion in Computer Science

您需要了解的所有内容都包含在这些页面中（或从中链接）。

在目录中搜索文件并列出其名称和路径-二级子文件夹

1 个答案: