Sub CreateSummary()
Dim oWord As Object
Dim WordWasNotRunning As Boolean
Dim oDoc As Object
Dim WS As Worksheet
Dim FN As Variant
Dim Phrase$
Dim Choice As Integer
Set WS = ActiveSheet
'See if Word is already running
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
On Error GoTo Err_Handler
Set oWord = CreateObject("Word.Application")
WordWasNotRunning = True
oWord.Visible = True 'Make the application visible to the user (if wanted)
End If
On Error GoTo Err_Handler
oWord.Visible = True
oWord.Activate
Set oDoc = oWord.Documents.Add(ThisWorkbook.Path & "\assessment template.dotx")
With oDoc.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[Property name]"
Phrase$ = WS.Range("D" & ActiveCell.Row)
.Replacement.Text = Phrase$
.Wrap = 0 'wdfindstop
.Execute Replace:=1 'Word.WdReplace.wdReplaceone
End With
With oDoc.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[Comment1]"
Phrase$ = WS.Range("E" & ActiveCell.Row)
.Replacement.Text = Phrase$
.Wrap = 0 'wdfindstop
.Execute Replace:=1 'Word.WdReplace.wdReplaceone
End With
With oDoc.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[Comment2]"
Phrase$ = WS.Range("F" & ActiveCell.Row)
.Replacement.Text = Phrase$
.Wrap = 0 'wdfindstop
.Execute Replace:=1 'Word.WdReplace.wdReplaceone
End With
'Parse suggested filename
Temp = Split(WS.Range("D" & ActiveCell.Row), ",")
If Temp(0) <> "" Then
FN = Temp(0)
oWord.FileDialog(2).InitialFileName = ThisWorkbook.Path & "\" & FN
Choice = oWord.FileDialog(2).Show
If Choice <> 0 Then
oWord.FileDialog(2).Execute
'Store the path and filename
WS.Range("G" & ActiveCell.Row) = oDoc.FullName
End If
End If
oDoc.Close False
If WordWasNotRunning Then
oWord.Quit
End If
'Make sure you release object references.
Set oWord = Nothing
Set oDoc = Nothing
Set myDialog = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
If WordWasNotRunning Then
oWord.Quit
End If
End Sub