Excel to Word Macro resulting in Run-time error 462-CodePudding

I've written a VBA macro which resides in an Excel workbook. When run, it will open an existing Word document (which is stored in the same directory as the Excel workbook), copy some content from cells in the Excel workbook into the Word document, save the Word doc under a new name (in the same directory) and kill the original Word doc. This process works as expected on first run. But on a second run, I get a Run-time error 462. I'm sure it's due to my ignorance around creating and using application instances within VBA code (I've just begun learning). I'm using Microsoft 365 Apps for Enterprise.

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.

CodePudding user response：

Is this what you are trying? I have commented the code but if you face any issues, simply ask. What you have is Early Binding. I have used Late Binding so that you do not need to add any references to the MS Word application.

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
        
    '~~> 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")
    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
    End With
    
    '~~> Delete original Word document
    Kill FlName
End Sub