循环遍历具有中间通配符模式的所有目录和子目录 [英] Loop through all the directories and sub-directories with intermediate wildcard patterns

问题描述

我有一个循环遍历所有目录的代码，但是我只需要在每个级别循环一些特定的目录。例如路径。 C：/主目录/ ABC * / Y / XYZ * / *。edf。

此代码通过递归给每个目录中的每个文件。我无法编辑它，以便它只给具有单个模式的子目录和该文件夹的子目录具有单个模式，然后它是具有另一个单个模式的子目录，然后只有.edf文件夹。我可以在这个代码中执行.edf文件。

我通过这两个函数来执行。

 函数递归（FolderPath As String）
 Dim值As String，Folders（）As String 
 Dim Folder As Variant，as As Long 
 ReDim Folders （0）
如果右（FolderPath，2）=\\然后退出函数
值= Dir（FolderPath，& H10）
直到Value =
如果Value =。或者Value =..然后
 Else 
如果GetAttr（FolderPath& Value）= 16然后
文件夹（UBound（Folders））=值
 ReDim保存文件夹（UBound （文件夹）+ 1）
 Else 
如果Count = 4然后
 temp（0，UBound（temp，2））= FolderPath 
 temp（1，UBound（temp，2 ））= Value 
 temp（2，UBound（temp，2））= Count'FileLen（FolderPath& Value）
 ReDim保存temp（UBound（temp，1），UBound（temp，2） + 1）
 End If 
 End If 
 End If 
 Value = Dir 
 Loop 
对于文件夹中的每个文件夹
 Count = Count + 1 
递归FolderPath&文件夹& \
计数=计数 -  1 
下一个文件夹
结束函数
  

和

 公共temp（）As String 
公共计数为整数
函数ListFiles FolderPath As String）
 Dim k As Long，i As Long 
 ReDim temp（2，0）
 Count = 1 
如果Right（FolderPath，1）<> \然后
 FolderPath = FolderPath& \
 End If 
递归FolderPath 
 k =范围（Application.Caller.Address）.Rows.Count 
如果k < UBound（temp，2）然后
 MsgBox有更多行，扩展用户定义的函数
 Else 
对于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）
结束函数
  / pre> 
 
解决方案
我使用了与Scripting.Dictionary对象不同的路由。在ABC和XYZ级别创建一个具有多个文件夹的目录结构（匹配和不匹配）后，我填充了最终的文件夹（* .txt和* .edf文件）。
 
 
 以下过程使用 Early Binding 加载Scripting.Dictionary对象，这要求将 Microsoft Scripting Runtime 添加到使用VBE的工具进行项目►参考。为了获得更多的普遍性，可以通过使用 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 Directory\ABC * \\如果UBound（Split（sFM，Chr（42）））< 2然后退出子'< ~~可能调整此安全
 sFM =替换（sFM，/，\）
 vFMs =拆分（sFM，Chr（92））
 
 sMASK = vFMs（LBound（vFMs））
 For fm = LBound（vFMs）+ 1 To UBound（vFMs）
 sMASK = Join（Array（sMASK，vFMs（fm） Chr（92））
如果CBool​​（InStr（1，vFMs（fm），Chr（42）））或fm = UBound（vFMs）然后
 build_FolderLevels dFNs，sFM：= sMASK，iFLDR：= Abs（（fm  sMASK = vbNullString 
结束如果
下一个fm 
 
'列出文件
对于每个fn在dFNs 
 Debug.Printfrom dict：& fn 
下一个fn 
 
 dFNs.RemoveAll：设置dFNs = Nothing 
 End Sub 
 
 Sub build_FolderLevels（dFMs As Scripting.Dictionary，_ 
可选sFM As String =，_ 
可选iFLDR As Long = 0）
 Dim d As Long，fp As String，vFMs As Variant 
 
如果CBool​​（dFMs。 Count）然后
 vFMs = dFMs.Keys 
对于d = LBound（vFMs）到UBound（vFM）
 vFMs（d）= vFMs（d）& sFM 
下一步d 
 Else 
 vFMs = Array（sFM）
如果
 dFMs.RemoveAll 
 
对于d = LBound（vFM）对于UBound（vFM）
 fp = Dir（vFMs（d），iFLDR）
尽管CBool​​（Len（fp））
 dFMs.Add Key：= Left（vFMs（d） InStrRev（vFMs（d），Chr（92）））& fp，_ 
项目：= iFLDR 
 fp = Dir 
循环
下一步d 
结束子
  
为了方便递归行为，我将字典键传递给一个变量数组，然后擦除字典。使用与新的通配符掩码连接的数组的元素，我重新填充了字典。冲洗并重复，直到所有可能的组合都已经运行。
 
 
 
以下是VBE的立即窗口的结果。
  main 
来自dict：t：\TMP\Main Directory\ABC\Y\XYZ\Temp.edf $来自dict的t $ b：t：\TMP\Main Directory\ABC\Y\XYZ\Temp1.edf 
来自dict：t：\TMP\Main Directory\ABC\来自dict：t：\TMP\Main Directory\ABC\Y\XYZ1\Temp.edf 
来自dict：t：\的Y \XYZ \Temp2.​​edf 
 TMP\Main Directory\ABC\Y\XYZ1\Temp1.edf 
来自dict：t：\TMP\Main Directory\ABC\Y\XYZ1\Temp2.​​edf $来自dict的t $ b：t：\TMP\Main Directory\ABC\Y\XYZ2\Temp.edf 
来自dict：t：\TMP\Main Directory\ABC\来自dict：t：\TMP\Main Directory \ABC\Y\XYZ2\Temp2.​​edf 
 from d ict：t：\TMP\Main Directory\ABC1\Y\XYZ\Temp.edf 
来自dict：t：\TMP\Main Directory\ABC1\Y\XYZ来自dict：t：\TMP \\ Directory \ABC1\Y\XYZ1\Temp.edf 
来自dict：t：\TMP\Main Directory\ABC1\Y\XYZ1\Temp1.edf 
 from dict：t：\TMP\Main Directory\ABC1\Y\XYZ1\Temp2.​​edf 
来自dict：t：\TMP\Main Directory\ABC1\Y\XYZ2 \Temp.edf 
来自dict：t：\TMP\Main Directory\ABC1\Y\XYZ2\Temp1.edf 
来自dict：t：\TMP\Main来自dict：t：\TMP\Main Directory\ABC2\Y\XYZ\Temp.edf 
的目录\ABC1\Y\XYZ2\Temp2.​​edf 
 dict：t：\TMP\Main Directory\ABC2\Y\XYZ\Temp1.edf 
来自dict：t：\TMP\\ \\ Main Directory\ABC2\Y\XYZ\Temp2.​​edf 
来自dict：t：\TMP\Main Directory\ABC2\Y\XYZ1\Temp.edf 
来自dict：t：\TMP\Main Directory\ABC2\Y\XYZ1\Temp1.edf 
来自dict：t：\TMP\Main Directory\ABC2\Y\\来自dict：t：\TMP\Main Directory\ABC2\Y\XYZ2\Temp.edf 
来自dict：t：\TMP\\的\\ XYZ1\Temp2.​​edf 
 \\ Main Directory\ABC2\Y\XYZ2\Temp1.edf 
来自dict：t：\TMP\Main Directory\ABC2\Y\XYZ2\Temp2.​​edf 
  
我也在您的原始通配符路径上运行了几个变体，类似的成功。
 
I have a code that loops through all the directories but I need to loop through some specific directories only at each level. e.g the path. C:/Main Directory/ABC*/Y/XYZ*/*.edf.

This code gives every file in every directory through recursion. I am unable to edit it so that it give only the sub-directories with a single pattern and the sub-directories of that folder with a single pattern and then it's sub-directories with another single pattern and then only the .edf files in that folder. I could do the .edf files thing though in this code

I'm doing it through these two functions.
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
And
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

解决方案
I took a different route with a Scripting.Dictionary object. After creating a directory structure with multiple folders at the ABC and XYZ levels (both matching and non-matching, I populated the final folders with both *.txt and *.edf files.

  
The following procedure loads the Scripting.Dictionary object with Early Binding. This requires that Microsoft Scripting Runtime be added to the project with the VBE's Tools ► References. For more universality, Late Binding can be used by initially dimming the dFNs variable as an object and using the 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
To facilitate the recursive behavior, I passed the dictionary keys off to a variant array and then scrubbed the dictionary. Using the elements of the array concatenated with the new wildcard mask, I repopulated the dictionary. Rinse and repeat until all possible combinations had been run through.

Here are the results from the VBE's Immediate window.
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
I also ran through several variations on your original wildcard path with similar success.

                        
这篇关于循环遍历具有中间通配符模式的所有目录和子目录的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！