Closing Word application using excel vba

[ChrisATBAse]

Hi everyone,

New to coding you I appreciate the help.

I need help closing the Word app after its finished. Everything in the code runs fine except when it comes to closing the word application. After running the code the edited document is saved and closed but the word application is still left open and i receive an error message, this causes a problem as I need to run this code numerous times. can someone help with this?

I've highlighted the problem area in red.

Error message:


Run-time error'-2147417848(80010108'):


Automation error
The object invoked has disconnected from its clients.



Sub ReplaceWordAndCopyPasteImage2()

Dim wdApp As Word.Application
Dim Wks As Excel.Worksheet
Dim wdDoc As Word.Document


Set Wks = ActiveSheet


Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True


Set wdDoc = wdApp.Documents.Open("C:\Users\Admin\Google Drive\SMS TEMPLATES\02 RISK ASSESSMENTS\002 Manual handling RA.docx")


Call ReplaceWords2(wdDoc, Wks, False)
Call CopyPasteImage2(wdDoc, Wks, False)





Set wdDoc = Nothing
Set wdApp = Nothing


End Sub






Sub ReplaceWords2(oDoc As Word.Document, Wks As Excel.Worksheet, Optional boolCloseAfterExec As Boolean = True)


Dim wdRng As Word.Range
Dim varTxt As Variant
Dim varRngAddress As Variant
Dim i As Long


varTxt = Split("an1,id1,rd1", ",")
varRngAddress = Split("C8,C5,C6", ",")


For Each wdRng In oDoc.StoryRanges


With wdRng.Find
For i = 0 To UBound(varTxt)
.Text = varTxt(i)
.Replacement.Text = Wks.Range(varRngAddress(i)).Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
Next i
End With


Next wdRng


oDoc.SaveAs2 Environ("UserProfile") & "\desktop\002 Manual handling RA " & Format(Now, "yyyy-mm-dd hh-mm-ss")
If boolCloseAfterExec Then
oDoc.Close
oDoc.Parent.Quit
End If


End Sub






Sub CopyPasteImage2(oDoc As Word.Document, Wks As Excel.Worksheet, Optional boolCloseAfterExec As Boolean = True)


With oDoc
.Activate


.ActiveWindow.View = wdNormalView
Wks.Range("K2:L15").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Bookmarks("CompanyLogo").Select
.Parent.Selection.Paste
.Parent.Selection.TypeParagraph




Wks.Range("N10:O14").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Bookmarks("ConsulSig").Select
.Parent.Selection.Paste
.Parent.Selection.TypeParagraph


.Save


If boolCloseAfterExec Then
oDoc.Close
oDoc.Parent.Quit
End If

End With

End Sub

[Kenneth Hobs]

There should be just one error line.

Maybe try:

If boolCloseAfterExec Then
dim o as object
set o = oDoc.Parent
oDoc.Close
o.Quit
Set oDoc = Nothing
Set o = Nothing
End If