使用 Word VBA 从文件夹和子文件夹中获取 doc 文件

Question

我正在将一堆 Word 文档插入到一个文件中以进行后期处理。当所有文件都在一个文件夹中时，我的脚本就可以工作了。但是，为了使其对未来的工作更加稳健，我想从某个起点插入所有文件夹和子文件夹（以及可能的其他子文件夹）中的 Word 文件。我按照这个 Youtube 教程：https://www.youtube.com/watch?v=zHJPliWS9FQ 考虑了所有文件夹和子文件夹，当然还针对我的特殊用途对其进行了修改。

  Sub CombineDocs()
    On Error Resume Next
    MsgBox "Opening"
    On Error GoTo 0

    Dim foldername As String 'parent folder
    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .Show
      On Error Resume Next
      foldername = .SelectedItems(1)
      Err.Clear
      On Error GoTo 0
    End With

    Documents.Add
    Selection.Style = ActiveDocument.Styles("Heading 1")
    Selection.TypeText Text:="Opening text"
    Selection.TypeParagraph
    Selection.InsertNewPage
    Selection.InsertBreak Type:=wdSectionBreakNextPage
    ActiveDocument.GoTo(What:=wdGoToPage, Count:=2).Select

    Dim fso As Scripting.FileSystemObject
    Dim file As Scripting.file
    getfolders foldername
  End sub

Sub getfolders(foldername)
    Set fso = New Scripting.FileSystemObject
    Call pastedoc(foldername)
    Set fso = Nothing
End Sub

Sub pastedoc(StartFolderPath as String)
    Dim file As Scripting.file
    Dim subfol As Scripting.folder
    Dim mainfolder As Scripting.folder
    Set mainfolder = fso.GetFolder(StartFolderPath )

    For Each file In mainfolder.Files
    If ((InStr(1, LCase(fso.GetExtensionName(file.Path)), "doc", vbTextCompare) > 0) Or _
         (InStr(1, LCase(fso.GetExtensionName(file.Path)), "docx", vbTextCompare) > 0)) And _
                (InStr(1, file.Name, "~$") = 0) Then
        Selection.InsertFile FileName:= _
        file.Path _
        , Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
        Selection.InsertBreak Type:=wdSectionBreakNextPage
        End If
    Next file

    For Each subfol In mainfolder.SubFolders
        pastedoc subfol.Path
    Next subfol
End Sub

我的代码和教程的不同之处在于我在主代码中定义父文件夹，而教程在子脚本中定义。结果我得到了一个

'需要对象'

“设置主文件夹”行中的错误。我尝试在主代码之间定义所有对象和名称并调用 subs，但我仍然无法让它工作。有什么可以修复代码的指导吗？

Answer 1

一个选项：假设CombineDocs 的End Sub 在getfolders 调用之后，您可以：

1. 完全删除getfolders

2. 在CombineDocs 中，说pastedoc foldername 而不是getfolders foldername

3. 将pastedoc的开头改为：

   Sub pastedoc(StartFolderPath as String)
       Dim fso As Scripting.FileSystemObject       ' ** Added
       Set fso = New Scripting.FileSystemObject    ' ** Added
   
       Dim file As Scripting.file
       Dim subfol As Scripting.folder
       Dim mainfolder As Scripting.folder
       Set mainfolder = fso.GetFolder(StartFolderPath )
   
       ' ... (everything else the same)
   

一般来说，您需要在使用它们的Sub 中或在模块顶部、任何子组件之外的Dim 变量。请尽可能将Dims 放在Subs 中，因为这会使您的代码更容易更改和维护。