excelvbaruntime-error

Calling methods on Word Doc error: Excel VBA throws run-time error 438: Object doesn't support this property or method


I've been working on this test code for a larger project for a few days, and keep running into these 438 errors. I received help with the first one here: 438 Error, but now that it's getting further, I'm getting the error on any and all methods on WordDoc. The idea is just to do a find/replace based on values in a spreadsheet against placeholders in the template doc (copied to avoid conflicts). As far as I have found, word docs have .Content.Find.etc methods, but I can't get this to run through to complete my tests.

The error occurs at line 22, even just with ".Content".

As this is my first VBA script accessing Word, I may have simple mistakes. But worth noting is that the Word doc copies and opens successfully before the error line.

Option Explicit

Sub Merge()
1    Dim WordDoc As Word.Document, N As Variant, i As Integer, j As Integer
2    'i = Range("C2").Value  'set formula to count relevant items
3    Dim wordApp As Word.Application
4    Dim source As String
5    Dim destination As String
6    Dim xlobj As Object
7    Set xlobj = CreateObject("Scripting.FileSystemObject")
8    'format: object.copyfile,source,destination,file overright(True is default)
9    source = "C:\Users\brian\Documents\Fiverr leads\hhornig89 - loan sheets\Documents\Loan Model V1\MERGE TEMPLATE - CONSTRUCTION LOAN AGREEMENT.docx"
10    destination = "C:\Users\brian\Documents\Fiverr leads\hhornig89 - loan sheets\Documents\Loan Model V1\WORKING - CONSTRUCTION LOAN AGREEMENT.docx"
11    xlobj.CopyFile source, destination, True
12    Set xlobj = Nothing
13    Set wordApp = CreateObject(Class:="Word.Application")
14    wordApp.Options.SaveInterval = 0
15    Set WordDoc = wordApp.Documents.Open("C:\Users\brian\Documents\Fiverr leads\hhornig89 - loan sheets\Documents\Loan Model V1\WORKING - CONSTRUCTION LOAN AGREEMENT.docx")
16    wordApp.Visible = True
17    Dim dataws As Worksheet
18    Set dataws = ThisWorkbook.Worksheets("Merge Fields")
19    N = dataws.Range("a1:b1").Value 'test range
20   'For j = 1 To i
21    With wordApp
22      With WordDoc.Content.Find
23            .Text = N(1, 1)
24            .Replacement.Text = N(1, 2)
25            .Wrap = wdFindContinue
26            .MatchWholeWord = True
27            .Execute Replace:=wdReplaceAll
28      End With
29    End With
30    'Next j
31    wordApp.ActiveDocument.Save
32    wordApp.ActiveDocument.Close
33    wordApp.Quit
34
35    Set wordApp = Nothing
36    Set WordDoc = Nothing
End Sub

Solution

  • I would ditch the library reference and use late-binding here. Ditch WordDoc and just reference ActiveDocument:

    Option Explicit
    
    Sub Merge()
    
        Dim N As Variant, i As Integer, j As Integer
        'i = Range("C2").Value  'set formula to count relevant items
        Dim wordApp As Object
        Dim source As String
        Dim destination As String
        Dim xlobj As Object
        
        Set xlobj = CreateObject("Scripting.FileSystemObject")
        
        'format: object.copyfile,source,destination,file overright(True is default)
        source = "C:\Users\brian\Documents\Fiverr leads\hhornig89 - loan sheets\Documents\Loan Model V1\MERGE TEMPLATE - CONSTRUCTION LOAN AGREEMENT.docx"
        destination = "C:\Users\brian\Documents\Fiverr leads\hhornig89 - loan sheets\Documents\Loan Model V1\WORKING - CONSTRUCTION LOAN AGREEMENT.docx"
        
        xlobj.CopyFile source, destination, True
        
        Set xlobj = Nothing
        Set wordApp = CreateObject("word.Application")
        
        wordApp.Options.SaveInterval = 0 'what's the point of this?
        wordApp.Documents.Open ("C:\Users\brian\Documents\Fiverr leads\hhornig89 - loan sheets\Documents\Loan Model V1\WORKING - CONSTRUCTION LOAN AGREEMENT.docx")
        wordApp.Visible = True
        
        Dim dataws As Worksheet
        Set dataws = ThisWorkbook.Worksheets("Merge Fields")
        
        N = dataws.Range("a1:b1").Value 'test range
        
       'For j = 1 To i
       
            With wordApp
               .ActiveDocument.Content.Find.Execute FindText:=N(1, 1), ReplaceWith:=N(1, 2), Replace:=2
            End With
        
        'Next j
        
        wordApp.ActiveDocument.Close True
        wordApp.Quit
    
        Set wordApp = Nothing
        
    End Sub