Last word document hangs and does not close properly

xiaoying

New Member
Joined
Dec 6, 2019
Messages
26
Office Version
  1. 365
Platform
  1. Windows
My code automates various letters using cell values from excel and replacing it into a Microsoft document. When running the automation, the first few word documents were able to close except for the last one. Does anyone have a solution for this? Thanks :)

VBA Code:
Option Explicit

Public Sub WordFindAndReplaceSave()
    
    Dim ws As Worksheet, msWord As Object
    Dim currentRow As Long
    Dim rowCount As Long
    Dim lastRow As Long
    Dim filename As String
    Dim Path1 As String
    Dim myD2Range As Range
    Dim myE2Range As Range
    Dim myF2Range As Range
    Dim myG2Range As Range
    Dim myRange As Range
    
    Path1 = "C:\Users\xlim\Desktop\Edited Letters"
    Set ws = ActiveSheet
    Set msWord = CreateObject("Word.Application")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row

    For currentRow = 2 To lastRow
    If Not ws.Rows(currentRow).Hidden Then
    filename = ws.Range("C" & currentRow).Value
    Set myD2Range = ws.Range("D" & currentRow)
    Set myE2Range = ws.Range("E" & currentRow)
    Set myF2Range = ws.Range("F" & currentRow)
    Set myG2Range = ws.Range("G" & currentRow)
    Set myRange = ws.Range("D" & currentRow & ":" & "G" & currentRow)
    
    With msWord
        .Visible = True
        .Documents.Open "C:\Users\xlim\Desktop\Engagement letter - STC.docx"
        .Activate

        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "DELVIN WONG WERN LIAT"
            .Replacement.Text = ws.Range("A" & currentRow).Value  'if currentRow is in use, replace firstCell with it

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "THE BOARD OF DIRECTORS"
            .Replacement.Text = ws.Range("B" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "KOOLOOK PTE. LTD."
            .Replacement.Text = ws.Range("C" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            
            If WorksheetFunction.CountA(myD2Range) < myD2Range.Count Then

            .Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
            .Replacement.Text = myE2Range & vbCr & myF2Range & vbCr & myG2Range

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
            
            ElseIf WorksheetFunction.CountA(myE2Range) < myE2Range.Count Then
            
            .Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
            .Replacement.Text = myD2Range & vbCr & myF2Range & vbCr & myG2Range
            
            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
            
            ElseIf WorksheetFunction.CountA(myF2Range) < myF2Range.Count Then
            
            .Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
            .Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myG2Range
            
            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
            
            ElseIf WorksheetFunction.CountA(myG2Range) < myG2Range.Count Then
            
            .Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
            .Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myF2Range
            
            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
            
            ElseIf WorksheetFunction.CountA(myRange) = myRange.Count Then

            .Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
            .Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myF2Range & vbCr & myG2Range

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
            
            End If
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "24 MAY 2019"
            .Replacement.Text = ws.Range("H" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "KPL/OAA/GTO/BK/AL"
            .Replacement.Text = ws.Range("I" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        msWord.ActiveDocument.SaveAs filename:=Path1 & "/" & "Engagement Letter - " & filename & ".docx"
        msWord.ActiveDocument.Close
        rowCount = rowCount + 1
    End With
    End If
    Next currentRow
End Sub

Capture.PNG
 

Attachments

  • Capture.PNG
    Capture.PNG
    75.9 KB · Views: 1

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

FormR

MrExcel MVP
Joined
Aug 18, 2011
Messages
6,480
Office Version
  1. 365
Platform
  1. Windows
Hi, try adding msWord.Quit right at the end of your code.
 

xiaoying

New Member
Joined
Dec 6, 2019
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Hi, try adding msWord.Quit right at the end of your code.
Hi FormR, thanks for your solution it works!!! I did a mistake of including active document inside the quit command as I thought the last word document was considered an active document. This thread is close.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,308
Messages
5,623,895
Members
415,999
Latest member
Sovereign maphoso

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top