Question

我有一个循环遍历所有目录的代码，但我只需要在每个级别循环一些特定的目录。例如路径。 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

Answer 1

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

^{以下过程使用早期绑定加载Scripting.Dictionary对象。这需要使用VBE的工具►参考将 Microsoft Scripting Runtime 添加到项目中。为了获得更多的普遍性，可以通过将 dFNs 变量初始调暗为对象并使用CreateObject method来使用延迟绑定。}

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 Directory\ABC*\Y\XYZ*\*.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

为了促进递归行为，我将字典键传递给变量数组，然后擦除字典。使用与新通配符掩码连接的数组元素，我重新填充了字典。冲洗并重复，直到完成所有可能的组合。

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

main
from dict: t:\TMP\Main Directory\ABC\Y\XYZ\Temp.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ\Temp1.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ\Temp2.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ1\Temp.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ1\Temp1.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ1\Temp2.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ2\Temp.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ2\Temp1.edf
from dict: t:\TMP\Main Directory\ABC\Y\XYZ2\Temp2.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ\Temp.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ\Temp1.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ\Temp2.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ1\Temp.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ1\Temp1.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ1\Temp2.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ2\Temp.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ2\Temp1.edf
from dict: t:\TMP\Main Directory\ABC1\Y\XYZ2\Temp2.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ\Temp.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ\Temp1.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ\Temp2.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ1\Temp.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ1\Temp1.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ1\Temp2.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ2\Temp.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ2\Temp1.edf
from dict: t:\TMP\Main Directory\ABC2\Y\XYZ2\Temp2.edf

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

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

1 个答案: