Word Document Vba Excel - Combing two different codes

[ChrisATBAse]

Gave this one a try but I keep getting errors during the find and replace function.

Sub M_snb()  sn=range("C5:C8")

  with Getobject("C:\Users\Admin\Google Drive\SMS TEMPLATES\02 RISK ASSESSMENTS\001 Electrical works RA.docx")
    activesheet.Shapes(1).CopyPicture
    .Paragraphs.First.Range.PasteSpecial
    activesheet.Shapes(2).CopyPicture
    .Paragraphs.Last.Range.PasteSpecial

    For Each it In .StoryRanges
      it.Find.execute "an1", , , , , , , , ,sn(1,4),2
      it.find.execute "id1", , , , , , , , ,sn(1,1),2
      it.find.execute  "rd1", , , , , , , , ,sn(1,2),2
    next

   .SaveAs2 "C:\Users\Admin\Google Drive\SMS TEMPLATES\02 RISK ASSESSMENTS\001 Electrical works RA.docx"
   .Close 0
  end with End Sub

The code below works well apart from the error that occurs when trying to close the word application.

Sub ReplaceWordAndCopyPasteImage()

    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\001 Electrical works RA.docx")


    Call ReplaceWords(wdDoc, Wks, False)
    Call CopyPasteImage(wdDoc, Wks, True)
    
    Set wdDoc = Nothing
    Set wdApp = Nothing


End Sub






Sub ReplaceWords(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\001 Electrical works RA " & Format(Now, "yyyy-mm-dd hh-mm-ss")
    If boolCloseAfterExec Then
        oDoc.Close
        oDoc.Parent.Quit
    End If


End Sub






Sub CopyPasteImage(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

I keep getting an error here any ideas how to fix this?

 .Save

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


    End With
End Sub

Error message:


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


Automation error
The object invoked has disconnected from its clients.