无法搜索/循环浏览子文件夹

Question

谁能帮助我为什么不能从子文件夹中提取文件？

如果文件位于主文件夹中，我的代码将定位并附加到电子邮件中，但如果文件位于子文件夹中，则不会。

代码示例：

Set obMail = Outlook.CreateItem(olMailItem)
With obMail
    .to = "email@comapny.com"
    .Subject = "O/S Blanace"
    .BodyFormat = olFormatPlain
    .Body = "Please see attached files"

    iRow = 24 'initialize row index from 24
    Do While Cells(iRow, 1) <> Empty

        'picking up file name from column A
        pFile = Dir(dPath & "\*" & Cells(iRow, 1) & "*")

        'checking for file exist in a folder and if its a pdf file
        If pFile <> "" And Right(pFile, 3) = "pdf" Then
            .Attachments.Add (dPath & "\" & pFile)
        End If

        'go to next file listed on the A column
        iRow = iRow + 1
    Loop

    .Send
End With

Answer 1

Dir 函数不会遍历子文件夹。它遍历你给它的路径，而不是树结构。它在调用时也会重置，因此递归调用不是一种选择。

所以如果你通过"C:\Test\"你可以使用它来遍历Test；如果单元格包含"C:\Test\NextTest\"，您可以使用它来迭代NextTest。

您可以做的是使用Collection 来保存每个目录并以这种方式递归探索。

有关如何执行此操作的示例，请参阅How To Traverse Subdirectories with Dir 中的以下内容

Sub TraversePath(path As String)
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection

    currentPath = Dir(path, vbDirectory)

    'Explore current directory
    Do Until currentPath = vbNullString
        Debug.Print currentPath
        If Left(currentPath, 1) <> "." And _
            (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
            dirCollection.Add currentPath
        End If
        currentPath = Dir()
    Loop

    'Explore subsequent directories
    For Each directory In dirCollection
        Debug.Print "---SubDirectory: " & directory & "---"
        TraversePath path & directory & "\"
    Next directory
End Sub


Sub Test()
    TraversePath "C:\Root\"
End Sub

您可以轻松地调整它以适应您的目的。