Unable to edit custom field in word through excel 2016 VBA

Question

I have been struggling quite a bit with trying to get this to work. I have an Excel workbook that contains information for clients. I want to click a button that runs a macro that takes a word document--a template--and update the fields in the template according to the data stored in the Excel workbook (i.e. I want the "client" custom property field in the template to change its value to "John Smith").

I am able to open the word document fine, and have had some success in updating the fields from word VBA, but I have not been able to get excel vba to update the fields of the word document. The error i get is 4248, ~"no document is open", which occurs at the for loop. If I place the for loop inside the OpenWordDoc, I still get the 4248 error. Any help is appreciated.

Here is the code I have been working with:

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

Cindy Meister Cindy Meister · Accepted Answer · 2019-03-01T08:34:56

The code in the question has a number of problems. I'll start with the "simple" one, even though it's not the first one.

Excel VBA doesn't "know" ActiveDocument

The following line should be triggering a compile error in Excel VBA, although it will work fine from within Word VBA:

For Each prop In ActiveDocument.CustomDocumentProperties

Excel VBA doesn't have an object ActiveDocument, only Word VBA has this. If the code is running in any environment other than Word VBA, this won't work. The VBA environment needs to be told in which library it can find this object; the Word library needs to be specified using the Application object for Word:

For Each prop In objWord.ActiveDocument.CustomDocumentProperties

Don't use ActiveDocument if at all possible

While ActiveDocument does work, it's not as reliable as working directly with an object. Since this code opens a document, it's possible to assign that document to an object variable when it's opened, then work with the object variable.

As the code in the question uses a separate procedure for opening the document, this can be changed from Sub to Function in order to return the document object.

Documents need to be searched in the same Word instance

In addition, the Word.Application object should be passed to the "open" procedure. The code in the question starts an instance of the Word application in both the first procedure and in the "open" procedure. These are separate instances, so a document opened in the "open" procedure won't be visible to the first procedure. That's the reason for the error reported.

The code can be changed to this (some "Dims" removed for clarity):

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

Unable to edit custom field in word through excel 2016 VBA

1 Answers