无法通过 excel 2016 VBA 在 word 中编辑自定义字段

Question

我一直在努力让它发挥作用。我有一个包含客户信息的 Excel 工作簿。我想单击一个按钮，该按钮运行一个宏，该宏接受一个 word 文档 - 一个模板 - 并根据 Excel 工作簿中存储的数据更新模板中的字段（即我想要“客户端”自定义属性字段在模板将其值更改为“John Smith”）。

我能够很好地打开word文档，并且在从word VBA更新字段方面取得了一些成功，但我无法让excel vba更新word文档的字段。我得到的错误是 4248, ~"no document is open"，发生在 for 循环中。如果我将 for 循环放在 OpenWordDoc 中，我仍然会收到 4248 错误。任何帮助表示赞赏。

这是我一直在使用的代码：

Sub GenDraftLetter()
Dim i As Long
Dim j As Double
Dim k As Object
Dim filenam As String
Dim prop As DocumentProperty
Dim oppname As String
Dim clientname As String
Dim objWord As Object
Dim ow As Window
Dim wd As Object
Dim fwd As Object

Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
    Set objWord = CreateObject("Word.Application")
End If
i = InputBox("Number of row for the Client", "Row for Client")
j = 1
Do Until Mid(Cells(i, 1), j, 1) = ","
    j = j + 1
Loop
clientname = Right(Cells(i, 1), Len(Cells(i, 1)) - j - 1) & " " & Left(Cells(i, 1), j - 1)
filenam = "template.docx"
OpenWordDoc (filenam)
For Each prop In ActiveDocument.CustomDocumentProperties
    If LCase(prop.Name) = "client" Then
        prop.Value = clientname
        Exit For
    End If
Next
End Sub



Private Sub OpenWordDoc(filenam)
Dim fullname As String
Dim driv As String
Dim filepat As String


    Set wordapp = CreateObject("word.Application")

    wordapp.Documents.Open filepat Thisworkbook.Path & "\" & filenam
    wordapp.Visible = True
    wordapp.Activate

Answer 1

问题中的代码有很多问题。我将从“简单”的开始，即使它不是第一个。

Excel VBA 不“知道”ActiveDocument

以下行应该会在 Excel VBA 中触发编译错误，尽管它可以在 Word VBA 中正常工作：

For Each prop In ActiveDocument.CustomDocumentProperties

Excel VBA 没有对象ActiveDocument，只有 Word VBA 有这个。如果代码在 Word VBA 以外的任何环境中运行，这将不起作用。需要告知 VBA 环境在哪个库中可以找到该对象； Word 库需要使用 Word 的 Application 对象来指定：

For Each prop In objWord.ActiveDocument.CustomDocumentProperties    

尽可能不要使用ActiveDocument

虽然ActiveDocument 确实有效，但它不如直接使用对象可靠。由于此代码打开了一个文档，因此可以在打开该文档时将该文档分配给一个对象变量，然后使用该对象变量。

由于问题中的代码使用单独的过程来打开文档，因此可以将其从 Sub 更改为 Function 以返回文档对象。

需要在同一个Word实例中搜索文档

此外，Word.Application 对象应传递给“打开”过程。问题中的代码在“打开”过程中的第一个过程 和 中启动 Word 应用程序的一个实例。这些是单独的实例，因此在“打开”过程中打开的文档对第一个过程不可见。这就是报错的原因。

代码可以改成这样（为了清楚起见，删除了一些“Dims”）：

Sub GenDraftLetter()
  Dim i As Long
  Dim j As Double
  Dim filenam As String
  Dim prop As Variant
  Dim clientname As String
  Dim objWord As Object
  Dim objDoc as Object

  Set objWord = GetObject(, "Word.Application")
  If objWord Is Nothing Then
    Set objWord = CreateObject("Word.Application")
  End If
  i = InputBox("Number of row for the Client", "Row for Client")
  j = 1
  Do Until Mid(Cells(i, 1), j, 1) = ","
    j = j + 1
  Loop
  clientname = Right(Cells(i, 1), Len(Cells(i, 1)) - j - 1) & " " & Left(Cells(i, 1), j - 1)
  filenam = "template.docx"
  Set objDoc = OpenWordDoc(filenam, objWord)
  For Each prop In objDoc.CustomDocumentProperties
    If LCase(prop.Name) = "client" Then
        prop.Value = clientname
        Exit For
    End If
  Next
End Sub

Private Function OpenWordDoc(filenam, objWord) as Object
    Dim objDoc as Object

    'In case the code is called where no Word object is open
    'Can be removed if this is not the intention of this procedure
    If objWord Is Nothing Then
       Set objWord = GetObject(, "Word.Application")
       If objWord Is NOthing Then
          Set objWord = CreateObject("Word.Application")
       End If
    End If

    Set objDoc = objWord.Documents.Open(Thisworkbook.Path & "\" & filenam)
    Set OpenWordDoc = objDoc
End Function