VBA script to pull various text value from an Excel sheet template into various Word docs

[aftbrah]

Hi everyone,

I've been browsing this forum for about 5 years and need some help!

This is a continuation of an older thread I managed to track down ( https://www.excelforum.com/excel-pro...-filepath.html. )

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

The solution that user Tinbendr was offering is precisely what I am looking for. However, I tried using the scripts and it doesn't work at all. No word doc was created nor any changes made to the existing word document in his attachment. Wondering if any Excel VBA masters on here can help out with this one? Attachment function on this forum does not work for me for some reason, otherwise I would have attached to this thread.



Thanks in advance for any help!

[AliGW]

Administrative Note:

Welcome to the forum.

Unfortunately, this is a duplicate thread, and you are allowed only ONE thread per issue here.

Please see Forum Rule #5 about thread duplication.

I am closing this thread, but you may continue here in the original thread: https://www.excelforum.com/excel-pro...soft-word.html