I've got an Excel data range I need to be able to paste into a Word document template and save automatically using a macro from Excel.
Currently when it is run, it tells me the template file is already open/locked and I have to open a read only copy for it to continue. It does create and save the word file but when I try open the saved word doc it says there are problems with the contents..
I've Googled a lot and think I'm close but if anyone can give me some pointers that would be appreciated.
Option Explicit
Sub CopyExcelDataToWord2()
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wsSource As Excel.Worksheet
Dim docWordTarget As Object
Dim SaveAsName As String
Dim customSavePath As String
Dim nameFile, WordName2
Dim ColRange As Range
Set wdDoc = wdApp.Documents.Open("C:\test\templ.dotx")
wdApp.Visible = True
'Cell with the filename to save final doc as
nameFile = Sheets("Form").Cells(70, 1).Value
'Gets the file path from cell and adds variable 'nameFile' value to the end
customSavePath = Worksheets("Form").Cells(57, 1).Value & "\" & nameFile & ".docx"
'sets the variable wsSource to the activesheet
Set wsSource = ThisWorkbook.ActiveSheet
Set ColRange = Sheets("Form").Range("A1:D54")
'if no data is selected then exit sub
If ColRange Is Nothing Then
Exit Sub
'sets variable WordName2 to the selected columns address
Else
'sets variable WordName2 to column Range
WordName2 = ColRange.Address
End If
'With word document make visible and select
With wdApp
.Visible = True
Set docWordTarget = .Documents.Open("C:\test\templ.dotx")
.ActiveDocument.Select
End With
'With excel workbook copy the column selected previously
With wsSource
.Range(WordName2).Copy
End With
'Paste data into word doc
With wdApp.Selection
.PasteExcelTable linkedtoexcel:=False, wordformatting:=False, RTF:=False
.TypeParagraph
End With
With wdApp
'Save word doc in the custom save path
.ActiveDocument.SaveAs Filename:=customSavePath
.ActiveWindow.Close
' Kill the Object
.Quit
End With
MsgBox "Exported To:" & vbNewLine & vbNewLine & (customSavePath)
Set docWordTarget = Nothing
Set wdApp = Nothing
Application.CutCopyMode = False
End Sub