Help! Exporting Excel data to Word

[crvazquez954]

I have the following code but can't figure out why when I export the information to word and generate a "proposal" it opens the actual template. When the user saves the report it's saving it over the original document. Is there any way we can fix it so that word uses the template to generate a new document while leaving the original template intact?

Sub Export_To_Word() 'FINAl TEST OF CELL DATA AND TABLE TRANSFER
'Name of the existing Word doc.
Const stWordReport As String = "Proposal.docm"


'Word objects.
Dim pappWord As Object
Dim docWord As Object
Dim wdbmRange As Word.Range


'Excel objects.
Dim wb As Excel.Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
Dim r As Range
Dim xlName As Excel.Name
Dim TodayDate As String


'Initialize the Excel objects.
Set wb = ActiveWorkbook
Set wsSheet = wb.Worksheets("Summary")
Set rnReport = wsSheet.Range("BidTable")


'Turn off screen updating.
Application.ScreenUpdating = False


'Remove formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With


For Each r In rnReport.Rows
If WorksheetFunction.Count(r) = 0 Then r.Hidden = True
Next


'Initialize the Word objects.
'Set pappWord = New Word.Application
Set pappWord = CreateObject("Word.Application")
Set docWord = pappWord.Documents.Open(wb.Path & "" & stWordReport)
Set wdbmRange = docWord.Bookmarks("BidTable").Range
pappWord.Visible = True


'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
On Error Resume Next
With docWord.InlineShapes(1)
.Select
.Delete
End With


'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName


On Error GoTo 0


rnReport.Copy 'Copy the report to the clipboard.


'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
.Select
.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End With


'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With

'Unhide hidden rows
Rows("26:48").Select
Selection.EntireRow.Hidden = False


'Restore formatting
Range("B28:D47").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With


Application.ScreenUpdating = True
End Sub

 

[crvazquez954]

Looks like all I had to do was change the following line:
Set docWord = pappWord.Documents.Open (wb.Path & "" & stWordReport)

to:

Set docWord = pappWord.Documents.Add(wb.Path & "" & stWordReport)