Excel to Word Macro resulting in Run-time error 462

Question

A VBA macro I created is housed in an Excel worksheet. When launched, it will open a Word document already in existence (stored in the same directory as the Excel workbook), copy data from Excel workbook cells into the Word document, save the Word document with a new name (also in the same directory), and then delete the original Word document. On the first try, this procedure operates as predicted. But after another run, I encounter Run-time Error 462. I'm sure it's because I'm still learning how to use and create application objects within VBA code. I make use of Microsoft 365 Apps for Business.

Sub ExcelToWord()

    Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim strFile As String

'Open Word file
    strFile = ("G:\HOME\Word File.docx")
    Set wordApp = CreateObject("word.Application")
    Set wDoc = wordApp.Documents.Open("G:\HOME\Word File.docx")
    wordApp.Visible = True

'Copy data from Excel to Word
    wDoc.ContentControls(1).Range.Text = Sheets("Model").Cells(4, 2)
    wDoc.ContentControls(2).Range.Text = Format(Date, "mm/dd/yyyy")
    wDoc.ContentControls(3).Range.Text = Sheets("Model").Range("X4")
    
    Word.Application.Activate

'Save Word Document with new name
    ActiveDocument.SaveAs Filename:=ActiveDocument.Path & "\" & Format(Sheets("Model").Range("B14"), "YYYY") & " " & ThisWorkbook.Sheets("Model").Range("B4") & " " & Format(Date, "YYYY-mm-dd") & ".docx"

'Delete original Word document
    Kill strFile

End Sub

I've researched this for hours and tried multiple solutions, including commenting out all of the Copy Data block to try and zero in on the error. But no luck. I hope I've posted this request properly. Thank you in advance for any help.

Answer 1

Are you attempting this (UNTESTED)? I've commented on on the code, but if you have any problems, just ask. You currently have Early Binding. You do not need to add references to the MS Word program because I have used Late Binding.

Option Explicit

Private Const wdFormatXMLDocument As Integer = 12

Sub ExcelToWord()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim FilePath As String
    Dim NewFileName As String
    Dim IOpenedWord As Boolean
        
    '~~> This is the original word file. Change as applicable
    FlName = "G:\HOME\Word File.docx"
    
    '~~> Check if word file exists
    If Dir(FlName) = "" Then
        MsgBox "Word File Not Found"
        Exit Sub
    End If
    
    '~~> Establish an Word application object if open
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")
    '~~> If not open then create a new word application instance 
    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
        '~~> I created Word instance so I have to close it as well
        IOpenedWord = True
    End If
    Err.Clear
    On Error GoTo 0
        
    oWordApp.Visible = True
        
    Set oWordDoc = oWordApp.Documents.Open(FlName)

    With oWordDoc
        '~~> File path
        FilePath = .Path & "\"
        
        '~~> New File name
        NewFileName = FilePath & _
                      Format(ThisWorkbook.Sheets("Model").Range("B14").Value, "YYYY") & _
                      " " & _
                      ThisWorkbook.Sheets("Model").Range("B4").Value & _
                      " " & _
                      Format(Date, "YYYY-mm-dd") & ".docx"
                      
        '~~> Copy data from Excel to Word
        .ContentControls(1).Range.Text = Sheets("Model").Cells(4, 2).Value2
        .ContentControls(2).Range.Text = Format(Date, "mm/dd/yyyy")
        .ContentControls(3).Range.Text = Sheets("Model").Range("X4").Value2
        
        '~~> Save the word document
        .SaveAs Filename:=NewFileName, FileFormat:=wdFormatXMLDocument
        
        DoEvents
        
        '~~> Close the file
        .Close (False)
    End With
    
    '~~> If I opened word then quit word
    If IOpenedWord = True Then oWordApp.Quit
    
    '~~> Delete original Word document
    Kill FlName
End Sub