附加 Word docx 文件，同时保持 VBA 格式答案

【问题标题】：Append Word docx files while keeping their format in VBA附加 Word docx 文件，同时保持 VBA 格式
【发布时间】：2020-08-03 16:12:49
【问题描述】：

我正在创建一个接收两个参数的 Word 宏：一个 docx 文档列表和新文件的名称。目标是宏将一个文档一个接一个地插入，保留它们各自的格式，并保存为新的 docx 文档。

Sub Merger(path As String, args () As Variant)
        Dim vArg As Variant
     
        Active Document.Select
        Selection.ClearFormatting

        For Each vArg In args
          ActiveDocument.Content.Words.Last.Select
          Selection.InsertFile:= _ vArg _,Range:="", _ConfirmConversions:= False, Link:=False, Attachment:= False )
          Selection.InsertBreak Type:=wdPageBreak
        Next vArg
      
        ActiveDocument.SaveAs2 File Name=path
        ActiveDocument.Close
        Application.Quit

请注意，我从一个空的 docx 文件中调用宏。

问题是原始文件的标题和格式都没有保留在新的docx文档中。

【问题讨论】：

Word 的数据模型不支持这一点。在文档中，样式和页眉/页脚是共享实体。
在您尝试编写代码之前，请手动执行操作。如果你找到了一种通过 Word UI 实现你想要的方法，你可以继续在代码中自动化它。
我已经设法改进了 de VBA 代码，现在，新文档保留了 de 页眉和页脚。问题持续成为风格......
见：msofficeforums.com/word-vba/…

标签： vba ms-word

【解决方案1】：

Word 格式不是模块化的。相反，考虑创建一个主文档，然后用子文档填充它。下面是从充满子文档的文件夹中创建主文档的代码：

Sub AssembleMasterDoc()
  Dim SubDocFile$, FolderPath$, Template$
  Dim Counter&
  Dim oFolder As FileDialog
  Dim oBookmark As Bookmark
  Dim oTOC As TableOfContents
'Create a dynamic array variable, and then declare its initial size
  Dim DirectoryListArray() As String
  ReDim DirectoryListArray(1000)
  Template$ = ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
'Loop through all the files in the directory by using Dir$ function
  Set oFolder = Application.FileDialog(msoFileDialogFolderPicker)
  With oFolder
    .AllowMultiSelect = False
    If .Show <> 0 Then
      FolderPath$ = .SelectedItems(1)
    Else
      GoTo EndSub
    End If
  End With
  Application.ScreenUpdating = False
  SubDocFile$ = Dir$(FolderPath$ & Application.PathSeparator & "*.*")
  Do While SubDocFile$ <> ""
      DirectoryListArray(Counter) = SubDocFile$
      SubDocFile$ = Dir$
      Counter& = Counter& + 1
  Loop

'Reset the size of the array without losing its values by using Redim Preserve
  ReDim Preserve DirectoryListArray(Counter& - 1)
  WordBasic.SortArray DirectoryListArray()
  ActiveWindow.ActivePane.View.Type = wdOutlineView
  ActiveWindow.View = wdMasterView
  Selection.EndKey Unit:=wdStory
  For x = 0 To (Counter& - 1)
    If IsNumeric(Left(DirectoryListArray(x), 1)) Then
      FullName$ = FolderPath$ & Application.PathSeparator & DirectoryListArray(x)
      Documents.Open FileName:=FullName$, ConfirmConversions:=False
      With Documents(FullName$)
        .AttachedTemplate = Template$
        For Each oBookmark In Documents(FullName$).Bookmarks
          oBookmark.Delete
        Next oBookmark
        .Close SaveChanges:=True
      End With
      Selection.Range.Subdocuments.AddFromFile Name:=FullName$, ConfirmConversions:=False
    End If
  Next x
  For Each oTOC In ActiveDocument.TablesOfContents
    oTOC.Update
  Next oTOC
  ActiveWindow.ActivePane.View.Type = wdPrintView
  Application.ScreenUpdating = True
EndSub:
End Sub

此代码来自以前的项目，因此您可能不需要全部，例如更新多个 TOC。

不要尝试维护和编辑主文档。格式容易损坏。相反，组装一个用于打印（或其他用途）的主文档，然后丢弃它。

【讨论】：