【VBA】【增強版】【收藏備用】遍歷文件夾內所有文件模塊V5

 N次修改了，此模塊應該比較健壯吧，特點：

1、可遍歷目錄下所有文件

2、可篩選文件類型，可限定文件名關鍵詞

3、遍歷目錄（文件夾）允許存在小數點.

4、一步到位，不用編寫2次循環（即先遍歷出目錄，再遍歷文件）

Sub searchFile()
'   ---------------遍歷文件夾內所有文件-----------------------------
   FileType = ".txt"  '查找文件類型
   FileKeyword = "svr"  '進一步限定文件範圍，當然也可以繼續添加限定條件
    '對話框方式選擇路徑
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then
        sFolderPath = fd.SelectedItems(1)
        Set fd = Nothing
    Else
        Set fd = Nothing
        Exit Sub
    End If
    
    Dim file() As String, retFile() As String, fullPath$
    Dim i%, k%, t%, f$
    i = 1:    k = 1:    t = 1
    
    ReDim file(1 To i)
    file(1) = sFolderPath & "\"
    '相對而言i父目錄，k爲對應子目錄
    Do Until i > k
        Debug.Print "file(" & i & ")=" & file(i)
        f = Dir(file(i), vbDirectory)
            Do Until f = ""
                Debug.Print "f1=" & f
                If InStr(f, FileType) > 0 And InStr(f, FileKeyword) > 0 Then
                    ReDim Preserve retFile(1 To t)
'                    把遍歷得到的文件存放到retFile(t)中
                    retFile(t) = file(i) & f
                    t = t + 1
                ElseIf f <> "." And f <> ".." Then
                    fullPath = file(i) & f & "\"
                    If FileFolderExists(fullPath) Then
                        k = k + 1
                        ReDim Preserve file(1 To k)
                        file(k) = fullPath
                    End If
                End If
                f = Dir
            Loop
        i = i + 1
    Loop
 
 
End Sub
 
 
 
Function FileFolderExists(strFullPath As String) As Boolean
 
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.folderExists(strFullPath) Then FileFolderExists = True
    Set fso = Nothing
 
End Function