使用VBA搜索文件夹或子文件夹内的文件

Question

我正在尝试使用 Excel 的 VBA 搜索网络子文件夹内的文件。目前，我可以搜索到主文件夹

search

，如图所示。例如，如果我通过在 Excel 文件中写入

1_maual

pdf 文件进行搜索，它将打开该 pdf 文件。现在我想打开子文件夹内的文件，如

Hello_1

，因为子文件夹是手动创建的，每次我都可以在VBA代码中指定子文件夹路径。所以我尝试编写VBA代码来搜索子文件夹，但我无法得到解决方案。

Public Const NETWORK_PATH As String = "C:\Users\WS035\Desktop\serach"
Public Const F_PATH20 As String = NETWORK_PATH

Function file_itiran(serchfile_path As String, key_word As String, fi_name() As String, file_num As Integer) As Integer
Dim str1, dir_ret As String

str1 = serchfile_path & key_word
dir_ret = Dir(str1, vbDirectory)
If dir_ret <> "" Then fi_name(file_num) = (serchfile_path & dir_ret)
While dir_ret <> ""
    dir_ret = Dir
    file_num = file_num + 1
    If dir_ret <> "" Then fi_name(file_num) = serchfile_path & dir_ret
Wend
file_itiran = file_num

End Function

Function GetSubfolders(folderPath As String) As Variant
Dim subfolders As Variant
Dim folder As Object

On Error Resume Next
Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
On Error GoTo 0

If Not folder Is Nothing Then
    subfolders = folder.subfolders
End If

GetSubfolders = subfolders
End Function

Function drawing_path1(hinban As String, f_name() As String) As Integer
Dim search_path As String
Dim file_num As Integer
Dim Filename As String
Dim subfolders As Variant
Dim subfolder As Object

file_num = 0

' Convert to uppercase and remove suffix
hinban = UCase(sufficdel(hinban))

' Search for files in the main folder
search_path = F_PATH20 & "\"
file_num = file_itiran(search_path, hinban & "*.*", f_name(), file_num)

' Search for files in subfolders
subfolders = GetSubfolders(F_PATH20)

If Not IsEmpty(subfolders) Then
    For Each subfolder In subfolders
        search_path = F_PATH20 & "\" & subfolder.Name & "\"
        file_num = file_itiran(search_path, hinban & "*.*", f_name(), file_num)
    Next subfolder
End If

End Function

Answer 1

这是一组简单的递归函数，应该适合您......

Option Explicit

Sub GetFilesInFolder(ByVal strFolderPath As String)
    Dim objFSO As Object, objFolder As Object, objSubFolder As Object, objFile As Object
    
    ' Create a FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Get the folder object
    Set objFolder = objFSO.GetFolder(strFolderPath)
    
    ' Loop through each file in the folder
    For Each objFile In objFolder.Files
        Debug.Print objFile.Path
    Next
    
    ' Recursively process subfolders
    For Each objSubFolder In objFolder.Subfolders
        GetFilesInFolder objSubFolder.Path
    Next
End Sub

Sub TestGetFilesInFolder()
    ' Specify the folder path you want to start from
    Dim strFolderPath As String
    
    strFolderPath = "C:\YourFolder"
    
    ' Call the recursive function to get files in the folder and its subfolders
    GetFilesInFolder strFolderPath
End Sub

...您只需要对其进行调整，使其专门适合您。