Question

我有一个代码，它在子文件夹和循环中循环从word文档中获取数据。但是在循环并到达子文件夹中的最后一个文档之后，控件不会返回到主文件夹＆amp;然后是下一个子文件夹。请看我的代码。帮助我在哪里做错了。

Option Explicit

Dim FSO As Scripting.FileSystemObject
Dim strFolderName As String
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim FileToOpen As String

Sub FindFilesInSubFolders()
    Dim fsoFolder As Scripting.Folder

    FileToOpen = "*v2.1.doc*"

    If FSO Is Nothing Then
       Set FSO = New Scripting.FileSystemObject
    End If

    'Set the parent folder for the new subfolders

    strFolderName = "C:\Test"
    Set fsoFolder = FSO.GetFolder(strFolderName)
    Set wrdApp = CreateObject("Word.Application")

    OpenFilesInSubFolders fsoFolder
    wrdApp.Quit
End Sub

Sub OpenFilesInSubFolders(fsoPFolder As Scripting.Folder)
    Dim fsoSFolder As Scripting.Folder
    Dim fileDoc As Scripting.File

    For Each fsoSFolder In fsoPFolder.SubFolders

        For Each fileDoc In fsoSFolder.Files
            If fileDoc.Name Like FileToOpen Then
            Set wrdDoc = wrdApp.Documents.Open(fileDoc.Path)
            With wrdApp
               .ActiveDocument.Tables(1).Select
               .Selection.Copy
               ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial xlPasteValues
           End With
           wrdDoc.Close False
           'wrdApp.Quit
           End If
       Next fileDoc

       OpenFilesInSubFolders fsoSFolder
    Next fsoSFolder

End Sub

Answer 1

我稍微修改了你的代码，以便它可以在我的Office Word 2007上运行，并且运行得非常好......以下是遍历所有文件夹的最小循环。

另请注意，您在第一次调用OpenFilesInSubFolders时忘记处理该文件夹的文件。

Dim wrdApp As Object
Dim FileToOpen As String

Sub FindFilesInSubFolders()
Dim FSO As Object
Dim strFolderName As String
Dim FileToOpen As String
Dim fsoFolder As Object

    FileToOpen = "*v2.1.doc*"

    If FSO Is Nothing Then
       Set FSO = CreateObject("Scripting.FileSystemObject")
    End If
    Set wrdApp = CreateObject("Word.Application")

    'Set the parent folder for the new subfolders

    strFolderName = "C:\test"
    Set fsoFolder = FSO.GetFolder(strFolderName)

    OpenFilesInSubFolders fsoFolder
 End Sub

Sub OpenFilesInSubFolders(fsoFolder As Object)
Dim fsoSFolder As Object
Dim fileDoc As Object
Dim wrdDoc As Object
    '
    ' First process the files of the curent directory, ...
    '
    For Each fileDoc In fsoFolder.Files
        If fileDoc.Name Like FileToOpen Then
            Debug.Print fileDoc.Path
            Set wrdDoc = wrdApp.Documents.Open(fileDoc.Path)
            With wrdApp
            .ActiveDocument.Tables(1).Select
                .Selection.Copy
                ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial xlPasteValues
            End With
            wrdDoc.Close False
        End If
    Next fileDoc
    '
    ' ...then process all subdirectories
    '
    For Each fsoSFolder In fsoFolder.SubFolders
        OpenFilesInSubFolders fsoSFolder
    Next fsoSFolder
End Sub

Answer 2

为什么不直接使用windows shell搜索目录并迭代输出呢？

Sub SO()

Dim files As Variant, file As Variant

files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR ""C:\test\*v2.1.doc*"" /S /B /A:-D").StdOut.ReadAll,vbCrLf), ".")

For Each file In files
    Debug.Print CStr(file)
Next

End Sub

无需遍历所有文件夹，只需一次点击即可获取文件。

如何离开子文件夹＆amp;使用VBA访问主文件夹？

2 个答案: