无法使用VBA在一批word文档的标题中添加表格

如何解决无法使用VBA在一批word文档的标题中添加表格

我正在尝试编写一个宏来打开特定文件夹中的 .docx 文件，删除标题的内容，然后在标题中插入一个表格，最后 - 保存并关闭文档，以便它可以移动到下一个一个依次。一切正常——除了它试图创建表格的那一行。我的代码如下：

Sub BatchAddTabletoHeaders()

    Dim wrd As Word.Application
    
    Set wrd = CreateObject("word.application")
    wrd.Visible = True
    FName = Dir("C:\MyFolder\*.docx")
    
    do while (FName <> "")
        With wrd
            ' Open the next document in the folder
            .Documents.Open ("C:\MyFolder\" & FName)
            
            ' select the header,delete it and then insert a table
            .ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryHeader
            With .Selection
                .WholeStory
                .Delete
                .Tables.Add Range:=Selection.Range,NumRows:=1,NumColumns:=3,DefaultTableBehavior:=wdWord9TableBehavior,AutoFitBehavior:=wdAutoFitFixed
            End With
            
            .ActiveDocument.Save
            .ActiveDocument.Close
            
        End With
        FName = Dir
    Loop
    Set wrd = nothing
End Sub

我收到的错误如下：

运行时错误“-2147023170 (800706be)”：

自动化错误

远程过程调用失败。

奇怪的是，只要我不试图打开和浏览一批文档，它就会很高兴地在标题中插入一个表格。下面的宏工作得很好：

Sub InsertTableIntoCurrentDocumentHeader()
    ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryHeader
    With Selection
        .WholeStory
        .Delete
        .Tables.Add Range:=Selection.Range,AutoFitBehavior:=wdAutoFitFixed
    End With
End Sub

是否有人能够深入了解为什么我的“批头”宏失败？

解决方法

例如：

Sub BatchAddTableToHeaders()
Dim wdApp As New Word.Application,wdDoc As Word.Document,FName
FName = Dir("C:\MyFolder\*.docx")
With wdApp
  .Visible = False
  Do While (FName <> "")
    ' Open the next document in the folder
    Set wdDoc = .Documents.Open(FileName:="C:\MyFolder\" & FName,AddToRecentFiles:=False)
    With wdDoc
      With .Sections.First.Headers(wdHeaderFooterPrimary).Range
        .Text = vbNullString
        .Tables.Add Range:=.Duplicate,NumRows:=1,NumColumns:=3,DefaultTableBehavior:=wdWord9TableBehavior,AutoFitBehavior:=wdAutoFitFixed
      End With
      .Close SaveChanges:=True
    End With
    FName = Dir
  Loop
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub