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

我的代码与教程之间的区别在于我在主代码中定义了父文件夹，教程在子脚本中进行了操作。结果我得到了

'对象需要'

'set mainfolder'行中出现

错误。我尝试在主代码和调用subs之间定义所有对象和名称，但我仍然无法使其工作。什么可以修复代码？

Answer 1

一个选项：假设Field1 Field2 Anonymous AA 12 BB之后的End Sub为CombineDocs，您可以：

完全删除getfolders
在getfolders中，说CombineDocs代替pastedoc foldername
将getfolders foldername的开头更改为：
```
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)中使用Dim个变量，或者在模块的顶部，在任何潜艇之外。请尽可能将Sub放在Dim内，因为这样可以更轻松地更改和维护代码。

使用Word VBA

1 个答案: