使用中间通配符模式循环遍历所有目录和子目录



我有一个代码可以在所有目录中循环,但我只需要在每个级别上循环一些特定的目录。例如路径。C:/主目录/ABC*/Y/XYZ*/*.edf.

此代码通过递归提供每个目录中的每个文件。我无法编辑它,使其只提供具有单一模式的子目录和具有单一模式文件夹的子目录,然后是具有另一个单一模式的分目录,然后只提供该文件夹中的.edf文件。我可以在这个代码中做.edf文件的事情

我是通过这两个函数来完成的。

Function Recursive(FolderPath As String)
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
ReDim Folders(0)
If Right(FolderPath, 2) = "\" Then Exit Function
Value = Dir(FolderPath, &H10)
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            If Count = 4 Then
                temp(0, UBound(temp, 2)) = FolderPath
                temp(1, UBound(temp, 2)) = Value
                temp(2, UBound(temp, 2)) = Count ' FileLen(FolderPath & Value)
                ReDim Preserve temp(UBound(temp, 1), UBound(temp, 2) + 1)
                End If
        End If
    End If
    Value = Dir
Loop
For Each Folder In Folders
    Count = Count + 1
    Recursive FolderPath & Folder & ""
    Count = Count - 1
Next Folder
End Function

Public temp() As String
Public Count As Integer
Function ListFiles(FolderPath As String)
Dim k As Long, i As Long
ReDim temp(2, 0)
Count = 1
If Right(FolderPath, 1) <> "" Then
    FolderPath = FolderPath & ""
End If
Recursive FolderPath
k = Range(Application.Caller.Address).Rows.Count
If k < UBound(temp, 2) Then
    MsgBox "There are more rows, extend user defined function"
Else
    For i = UBound(temp, 2) To k
          ReDim Preserve temp(UBound(temp, 1), i)
            temp(0, i) = ""
            temp(1, i) = ""
            temp(2, i) = ""
    Next i
End If
ListFiles = Application.Transpose(temp)
ReDim temp(0)
End Function

我使用Scripting.Dictionary对象采用了不同的方法。在创建了一个包含ABC和XYZ级别(匹配和不匹配)的多个文件夹的目录结构后,我用*.txt和*.edf文件填充了最终文件夹。

以下过程使用Early Binding加载Scripting.Dictionary对象。这需要使用VBE的工具将Microsoft Scripting Runtime添加到项目中►参考文献。为了获得更多的通用性,可以通过最初将dFNs变量调暗为对象并使用CreateObject方法来使用后期绑定

Sub main()
    Dim fm As Long, sFM As String, vFMs As Variant, sMASK As String
    Dim fn As Variant, dFNs As New Scripting.Dictionary
    sFM = Environ("TMP") & "Main DirectoryABC*YXYZ**.edf"
    If UBound(Split(sFM, Chr(42))) < 2 Then Exit Sub  '<~~possibly adjust this safety
    sFM = Replace(sFM, "/", "")
    vFMs = Split(sFM, Chr(92))
    sMASK = vFMs(LBound(vFMs))
    For fm = LBound(vFMs) + 1 To UBound(vFMs)
        sMASK = Join(Array(sMASK, vFMs(fm)), Chr(92))
        If CBool(InStr(1, vFMs(fm), Chr(42))) Or fm = UBound(vFMs) Then
            build_FolderLevels dFNs, sFM:=sMASK, iFLDR:=Abs((fm < UBound(vFMs)) * vbDirectory)
            sMASK = vbNullString
        End If
    Next fm
    'list the files
    For Each fn In dFNs
        Debug.Print "from dict: " & fn
    Next fn
    dFNs.RemoveAll: Set dFNs = Nothing
End Sub
Sub build_FolderLevels(dFMs As Scripting.Dictionary, _
                       Optional sFM As String = "", _
                       Optional iFLDR As Long = 0)
    Dim d As Long, fp As String, vFMs As Variant
    If CBool(dFMs.Count) Then
        vFMs = dFMs.Keys
        For d = LBound(vFMs) To UBound(vFMs)
            vFMs(d) = vFMs(d) & sFM
        Next d
    Else
        vFMs = Array(sFM)
    End If
    dFMs.RemoveAll
    For d = LBound(vFMs) To UBound(vFMs)
        fp = Dir(vFMs(d), iFLDR)
        Do While CBool(Len(fp))
            dFMs.Add Key:=Left(vFMs(d), InStrRev(vFMs(d), Chr(92))) & fp, _
                     Item:=iFLDR
            fp = Dir
        Loop
    Next d
End Sub

为了便于递归行为,我将dictionary键传递给了一个变量数组,然后删除了dictionary。使用与新通配符掩码连接的数组元素,我重新填充了字典。冲洗并重复,直到所有可能的组合都通过为止。

以下是VBE的立即窗口的结果。

main
from dict: t:TMPMain DirectoryABCYXYZTemp.edf
from dict: t:TMPMain DirectoryABCYXYZTemp1.edf
from dict: t:TMPMain DirectoryABCYXYZTemp2.edf
from dict: t:TMPMain DirectoryABCYXYZ1Temp.edf
from dict: t:TMPMain DirectoryABCYXYZ1Temp1.edf
from dict: t:TMPMain DirectoryABCYXYZ1Temp2.edf
from dict: t:TMPMain DirectoryABCYXYZ2Temp.edf
from dict: t:TMPMain DirectoryABCYXYZ2Temp1.edf
from dict: t:TMPMain DirectoryABCYXYZ2Temp2.edf
from dict: t:TMPMain DirectoryABC1YXYZTemp.edf
from dict: t:TMPMain DirectoryABC1YXYZTemp1.edf
from dict: t:TMPMain DirectoryABC1YXYZTemp2.edf
from dict: t:TMPMain DirectoryABC1YXYZ1Temp.edf
from dict: t:TMPMain DirectoryABC1YXYZ1Temp1.edf
from dict: t:TMPMain DirectoryABC1YXYZ1Temp2.edf
from dict: t:TMPMain DirectoryABC1YXYZ2Temp.edf
from dict: t:TMPMain DirectoryABC1YXYZ2Temp1.edf
from dict: t:TMPMain DirectoryABC1YXYZ2Temp2.edf
from dict: t:TMPMain DirectoryABC2YXYZTemp.edf
from dict: t:TMPMain DirectoryABC2YXYZTemp1.edf
from dict: t:TMPMain DirectoryABC2YXYZTemp2.edf
from dict: t:TMPMain DirectoryABC2YXYZ1Temp.edf
from dict: t:TMPMain DirectoryABC2YXYZ1Temp1.edf
from dict: t:TMPMain DirectoryABC2YXYZ1Temp2.edf
from dict: t:TMPMain DirectoryABC2YXYZ2Temp.edf
from dict: t:TMPMain DirectoryABC2YXYZ2Temp1.edf
from dict: t:TMPMain DirectoryABC2YXYZ2Temp2.edf

我还在您的原始通配符路径上运行了几个变体,并取得了类似的成功。

最新更新