查找和列出文件名扩充以包含子文件夹

Question

我有两个代码。将搜索并命名目录中的每个文件夹。另一个将列出单个文件夹中的文件和文件名。我对 VBA 不够熟练，无法解决这个问题，所以我需要 StackOverflow！

这是文件名列表程序：

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
    Set objFolder = objFSO.GetFolder("\\fc8fsp01\litho_recipe_amat_data")
    i = 1
'loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
    'print file name
        Cells(i + 1, 1) = objFile.Name
    'print file path
        Cells(i + 1, 2) = objFile.Path
        i = i + 1
Next objFile
End Sub

这是第二个将导航子文件夹以写入文件夹名称的代码：

Option Explicit

Dim i As Long, j As Long
Dim searchfolders As Variant
Dim FileSystemObject

    Sub ListOfFolders()
        Dim LookInTheFolder As String

        i = 1
        LookInTheFolder = "\D: ' As you know; you should modificate this row.
        Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
        For Each searchfolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders
            Cells(i, 1) = searchfolders
            i = i + 1
            SearchWithin searchfolders
        Next searchfolders

    End Sub

Sub SearchWithin(searchfolders)
        On Error GoTo exits
    For Each searchfolders In FileSystemObject.GetFolder(searchfolders).SubFolders
        j = UBound(Split(searchfolders, "\"))
        Cells(i, j) = searchfolders
        i = i + 1
        SearchWithin searchfolders
        Next searchfolders
exits:
End Sub

我需要一个代码来搜索所有子文件夹并列出包含的所有文件。请帮助D：

Answer 1

由于我访问的某些文件夹存在于网络驱动器上时的速度问题，我编写了一个使用 Windows Shell dir 命令的小 VBA 程序。使用正确的参数，这将返回基目录中的所有文件；以及所有子文件夹和文件等等。我让它将结果写入一个文本文件，然后我将其读入 Excel 进行进一步处理。

与使用 VBA 的 DIR 或 FSO 相比，当文件位于网络驱动器上时，它的运行速度大约快五倍 - 在本地计算机上时不那么明显 - 但我将其作为另一种方法介绍。

您必须设置对Windows Script Host Object Model 的引用。 sDrive 和sBasePath 用于设置起始文件夹名称。 sFileList 是将结果写入文本文件的位置。

/S 参数显示指定目录和所有子目录中的文件。 /B 参数导致省略标题信息和摘要

如果您运行CMD.EXE 并在dir 命令上寻求帮助，您将看到对其他参数的解释。

---

Public sDrive As String
Public sBasePath As String
Public Const sFileList As String = "C:\Users\Ron\FileList.txt"
Option Explicit
Sub GetDirTree()
    Dim WSH As WshShell
    Dim lErrCode As Long

Set WSH = New WshShell
lErrCode = WSH.Run("cmd.exe /c dir """ & sDrive & sBasePath & """/B /S >" & sFileList, 0, True)
If lErrCode <> 0 Then
    MsgBox ("Error in GetDirTree: Error Number: " & CStr(lErrCode))
    Stop
End If

End Sub

---

Answer 2

这是我用来查找目录中所有文件的函数。

Public Function RecursiveDir(colFiles As Collection, _
                      ByVal strFolder As String, _
                      strFileSpec As String, _
                      bIncludeSubfolders As Boolean)

 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant

'Add files in strFolder matching strFileSpec to colFiles
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)
 Do While strTemp <> vbNullString
 colFiles.Add strFolder & strTemp
 strTemp = Dir
 Loop

'Fill colFolders with list of subdirectories of strFolder
 If bIncludeSubfolders Then
     strTemp = Dir(strFolder, vbDirectory)
     Do While strTemp <> vbNullString
       If (strTemp <> ".") And (strTemp <> "..") Then
         If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
             colFolders.Add strTemp
         End If
     End If
     strTemp = Dir
 Loop

'Call RecursiveDir for each subfolder in colFolders
 For Each vFolderName In colFolders
     Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
 Next vFolderName
 End If

'Garbage collection
 Set colFolders = Nothing

End Function

此函数将填充给定目录中每个文件名的集合。如果您愿意，可以将bIncludeSubfolders 设置为True，它将递归搜索此目录中的所有子文件夹。要使用此功能，您需要以下内容：

Dim colFiles As New Collection ' The collection of files
Dim Path As String ' The parent Directory you want to search
Dim subFold As Boolean ' Search sub folders, yes or no?
Dim FileExt As String ' File extension type to search for

然后只需设置FileExt = "*.*" 它将查找具有每个文件扩展名的每个文件。希望这会有所帮助。