无法搜索/循环子文件夹

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

您可以轻松地根据您的目的进行调整。