在目录中搜索文件并列出它们的名称和路径 - 两级子文件夹
Searching directory for files and listing their name and path - two levels of subfolders
我目前正在尝试编辑另一个团队之前创建的宏
它非常成功地能够从特定位置检索所有文件名和路径，如果所有文件都在那里，非常有用。
我的问题是我正在尝试将其适应文件保存在 "Storage" 目录中的另一个区域
他们从这里开始：
Storage\ProposalFolder\（3 个文件夹中的 1 个）\文件
3 个文件夹中的 1 个有助于根据提案类型对它们进行排序
项目、前景或怀疑
所以我需要做的是有一个给定存储目录的宏，然后扫描每个提案子文件夹，然后查看文件存储在哪种文件夹类型中（如果文件在项目中，其他 2 个文件夹将是空的）
请看下面
存储视图
提案文件夹
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" 代码一样列出子文件夹中的文件，但我无法理解如何比一级子文件夹更进一步 - 代码注释掉了子文件夹是我：/
任何帮助都是超级的！
根据以上评论...
一个递归过程通常通过调用自身重复进入"lower levels"。显然，如果编码不当，这可能会导致问题，但本网站和其他网站上有无数代码示例，例如：
- 堆栈溢出：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
您需要知道的一切都包含在这些页面中（或链接自这些页面）。
我目前正在尝试编辑另一个团队之前创建的宏 它非常成功地能够从特定位置检索所有文件名和路径，如果所有文件都在那里，非常有用。
我的问题是我正在尝试将其适应文件保存在 "Storage" 目录中的另一个区域 他们从这里开始：
Storage\ProposalFolder\（3 个文件夹中的 1 个）\文件
3 个文件夹中的 1 个有助于根据提案类型对它们进行排序
项目、前景或怀疑
所以我需要做的是有一个给定存储目录的宏，然后扫描每个提案子文件夹，然后查看文件存储在哪种文件夹类型中（如果文件在项目中，其他 2 个文件夹将是空的）
请看下面
存储视图
提案文件夹
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" 代码一样列出子文件夹中的文件，但我无法理解如何比一级子文件夹更进一步 - 代码注释掉了子文件夹是我：/
任何帮助都是超级的！
根据以上评论...
一个递归过程通常通过调用自身重复进入"lower levels"。显然，如果编码不当，这可能会导致问题，但本网站和其他网站上有无数代码示例，例如：
- 堆栈溢出：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
您需要知道的一切都包含在这些页面中（或链接自这些页面）。