Consulting

Results 1 to 2 of 2

Thread: Closing Word application using excel vba

  1. #1

    Closing Word application using excel vba

    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


  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,884
    Location
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •