Unable to edit custom field in word through excel 2016 VBA - excel

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

Answer 1

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