ShadowSaxx
Board Regular
- Joined
- Nov 1, 2012
- Messages
- 68
I could use some help with this one. I have customized the code posted by users in these two forum postings:
Create Letters.doc in word with bookmarks in excel - Rockdrigotoca
Word Report using excel database - Samfolds
I created the test file per instructions, then tried to modify the code to spec as I need it to operate.
I am running into an issue on the file naming convention (Error: Valid File Name Path error) and am concerned the code is not pointing to the correct cells for the file name.
I did walk through the samples and built the sample file, which worked, but now I cannot get it to customize.
Here is the code:
Sub Create_Letters()
' Note: you will need to add error-trapping
Dim objX As Object
Dim rng1 As Range
Dim rng2 As Range
Dim wb As Workbook
Dim wsControl As Worksheet
Dim wsData As Worksheet
'
Dim oApp As Word.Application
Dim oBookMark As Word.Bookmark
Dim oDoc As Word.Document
'
Dim strDocumentFolder As String
Dim strTemplate As String
Dim strTemplateFolder As String
Dim lngTemplateNameColumn As Long
Dim strWordDocumentName As String
Dim lngDocumentNameColumn As Long
Dim lngRecordKount As Long ' not used but retained for future use
'
Set wb = ThisWorkbook
Set wsControl = wb.Worksheets("Control Sheet")
wsControl.Activate
Set wsData = wb.Worksheets(wsControl.[Data_Sheet].Value)
strTemplateFolder = wsControl.[Template_Folder].Value
strDocumentFolder = wsControl.[Document_Folder].Value
wsData.Activate
lngTemplateNameColumn = wsData.[Template_Name].Column
lngDocumentNameColumn = wsData.[Document_Name].Column
' number of letters required:
' must not have any blank cells in column A - except at the end
Set rng1 = wsData.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
lngRecordKount = rng1.Rows.Count
'
'Set oApp = CreateObject("Word Application")
Set oApp = New Word.Application
' Process each record in turn
For Each rng2 In rng1
strTemplate = strTemplateFolder & "\" & wsData.Cells(rng2.Row, lngTemplateNameColumn)
strWordDocumentName = strDocumentFolder & "\" & wsData.Cells(rng2.Row, lngDocumentNameColumn)
' check that template exists
If Dir(strTemplate) = "" Then
MsgBox strTemplate & " not found"
GoTo Tidy_Exit
End If
Set oDoc = oApp.Documents.Add
oApp.Selection.InsertFile strTemplate
' locate each bookmark
For Each oBookMark In oDoc.Bookmarks
Set objX = wsData.Rows(1).Find(oBookMark.Name, LookIn:=xlValues, LookAt:=xlWhole)
If Not objX Is Nothing Then
' found
If Right(oBookMark.Name, 2) = "Due_Date" Then
oBookMark.Range.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
ElseIf Right(oBookMark.Name, 22) = "Total_Billable" Then
oBookMark.Range.Text = Format(wsData.Cells(rng2.Row, objX.Column), "$#,##0.00")
Else
oBookMark.Range.Text = wsData.Cells(rng2.Row, objX.Column)
End If
Else
MsgBox "Bookmark '" & oBookMark.Name & "' not found", vbOKOnly + vbCritical, "Error"
GoTo Tidy_Exit
End If
Next oBookMark
'
oDoc.SaveAs strWordDocumentName & ".docx"
oDoc.Close
Next rng2
'
Tidy_Exit:
On Error Resume Next
Set oDoc = Nothing
Set oBookMark = Nothing
Set objX = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
oApp.Quit
Set oApp = Nothing
'
Set wsData = Nothing
Set wsControl = Nothing
Set wb = Nothing
'
End Sub
Here is the Document Name is in the 33rd column with the name and header of Document_Name. The oDoc.SaveAs strWordDocumentName & ".docx" should be [TABLE="width: 539"]
<tbody>[TR]
[TD]C:\Users\dt76266\Documents\Projects\Insert Form\Insert Letter Creator\Insert Documents
Sample: Formula and Values[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[TABLE="width: 500"]
<tbody>[TR]
[TD]Document_Name[/TD]
[TD]Document_Name[/TD]
[/TR]
[TR]
[TD]="Vendor Letter "&D2&""[/TD]
[TD]Vendor Letter CNL[/TD]
[/TR]
</tbody>[/TABLE]
I cannot seem to resolve the file name issue.
Any help would be appreciated.
Thanks,
-SS
Create Letters.doc in word with bookmarks in excel - Rockdrigotoca
Word Report using excel database - Samfolds
I created the test file per instructions, then tried to modify the code to spec as I need it to operate.
I am running into an issue on the file naming convention (Error: Valid File Name Path error) and am concerned the code is not pointing to the correct cells for the file name.
I did walk through the samples and built the sample file, which worked, but now I cannot get it to customize.
Here is the code:
Sub Create_Letters()
' Note: you will need to add error-trapping
Dim objX As Object
Dim rng1 As Range
Dim rng2 As Range
Dim wb As Workbook
Dim wsControl As Worksheet
Dim wsData As Worksheet
'
Dim oApp As Word.Application
Dim oBookMark As Word.Bookmark
Dim oDoc As Word.Document
'
Dim strDocumentFolder As String
Dim strTemplate As String
Dim strTemplateFolder As String
Dim lngTemplateNameColumn As Long
Dim strWordDocumentName As String
Dim lngDocumentNameColumn As Long
Dim lngRecordKount As Long ' not used but retained for future use
'
Set wb = ThisWorkbook
Set wsControl = wb.Worksheets("Control Sheet")
wsControl.Activate
Set wsData = wb.Worksheets(wsControl.[Data_Sheet].Value)
strTemplateFolder = wsControl.[Template_Folder].Value
strDocumentFolder = wsControl.[Document_Folder].Value
wsData.Activate
lngTemplateNameColumn = wsData.[Template_Name].Column
lngDocumentNameColumn = wsData.[Document_Name].Column
' number of letters required:
' must not have any blank cells in column A - except at the end
Set rng1 = wsData.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
lngRecordKount = rng1.Rows.Count
'
'Set oApp = CreateObject("Word Application")
Set oApp = New Word.Application
' Process each record in turn
For Each rng2 In rng1
strTemplate = strTemplateFolder & "\" & wsData.Cells(rng2.Row, lngTemplateNameColumn)
strWordDocumentName = strDocumentFolder & "\" & wsData.Cells(rng2.Row, lngDocumentNameColumn)
' check that template exists
If Dir(strTemplate) = "" Then
MsgBox strTemplate & " not found"
GoTo Tidy_Exit
End If
Set oDoc = oApp.Documents.Add
oApp.Selection.InsertFile strTemplate
' locate each bookmark
For Each oBookMark In oDoc.Bookmarks
Set objX = wsData.Rows(1).Find(oBookMark.Name, LookIn:=xlValues, LookAt:=xlWhole)
If Not objX Is Nothing Then
' found
If Right(oBookMark.Name, 2) = "Due_Date" Then
oBookMark.Range.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
ElseIf Right(oBookMark.Name, 22) = "Total_Billable" Then
oBookMark.Range.Text = Format(wsData.Cells(rng2.Row, objX.Column), "$#,##0.00")
Else
oBookMark.Range.Text = wsData.Cells(rng2.Row, objX.Column)
End If
Else
MsgBox "Bookmark '" & oBookMark.Name & "' not found", vbOKOnly + vbCritical, "Error"
GoTo Tidy_Exit
End If
Next oBookMark
'
oDoc.SaveAs strWordDocumentName & ".docx"
oDoc.Close
Next rng2
'
Tidy_Exit:
On Error Resume Next
Set oDoc = Nothing
Set oBookMark = Nothing
Set objX = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
oApp.Quit
Set oApp = Nothing
'
Set wsData = Nothing
Set wsControl = Nothing
Set wb = Nothing
'
End Sub
Here is the Document Name is in the 33rd column with the name and header of Document_Name. The oDoc.SaveAs strWordDocumentName & ".docx" should be [TABLE="width: 539"]
<tbody>[TR]
[TD]C:\Users\dt76266\Documents\Projects\Insert Form\Insert Letter Creator\Insert Documents
Sample: Formula and Values[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[TABLE="width: 500"]
<tbody>[TR]
[TD]Document_Name[/TD]
[TD]Document_Name[/TD]
[/TR]
[TR]
[TD]="Vendor Letter "&D2&""[/TD]
[TD]Vendor Letter CNL[/TD]
[/TR]
</tbody>[/TABLE]
I cannot seem to resolve the file name issue.
Any help would be appreciated.
Thanks,
-SS