Word Report using excel database

[samfolds]

Hello all,

I'm looking for a way to save/print several reports by changing only certain information in that report. Those information are placed in an excel database and all I want to do is somehow create a word template and link each column to a certain place. For example, say my excel database had the columns :

NamesAddressPhoneSam1234 pool st.123-456-7891Jack4321 sack st.323-525-9874Gil654 8th avenue325-525-8787Andrew987 9th st.322-252-5252

And my reports looks like this :

*****************************************
Hello "NAME",

blablablabla "PHONE" blablablabla.

blablablablablabla "ADDRESS".
*****************************************


I would like to loop through all the rows (1 report per row) and save the report in the form : Report-2010-"NAME".doc ...

Can someone enlight me on how to do that?

Thank you very much.

Samfolds

 

[prasadavasare]

Absolutly fantastic.......this does work for me....I just can't thank enogh for your time and efforts you put for me to resolve my problem....God Bless you and your family.....you just not only resolve my problem but you help me to boost my carrier and knowledge to some extend....Thank you very much for making my day.....You are the best!!!!

 

[Derek Brown]

Thank you for the update.
I am pleased that it is now working - I was beginning to run out of ideas.
I can only guess that it was the Vista operating system that didn't seem to like "early binding" for what we were trying to do.
Sorry that it took so long to sort out.

 

[Antz72]

Hi there,

Not sure if this thread is still active but hey may as well ask.

Is this macro meant to split and save all the records into seperate documents? I've followed all the steps above and got the macro working.

The short story is that I have a mail-merge of 800 records that I want to save as seperate word documents with a specific name. Obviously when you run a mail-merge it merges all records into the one word document - which I now want to split by page (One record per page). The macro mentioned here seemed like a pretty spot-on alternative way of doing it.

I am testing it on 10 records, and it saves 10 seperate .doc files, named perfectly as I wanted them, however - inside the files, there 10 pages with 1 record per page. Hopefully that makes sense, I was hoping that this would create 1 document for each single record.

Have I got the wrong idea?

This is the code I am currently using:

Option Explicit
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, 4) = "Date" Then
oBookMark.Range.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
ElseIf Right(oBookMark.Name, 6) = "Amount" 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
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


Any help at all would be appreciated

Thanks!

 

[Antz72]

By the way I am on Windows XP Professional and using Microsoft Word/Excel 2003...

Cheers

 

[Eric Young]

Derek this is an awesome tool!! Is there a way to have this keep the format of the template being used? I have objects, headers and footers in my template document however these items are not translating to the created document. I'm using office 2010. Thank you, in advance!!!

Here is the code - press Alt +F11 and create a new code module and enter the following code:
You will need to use Tools | Reference to add a reference to the Microsoft Word Object 11.0 Library (it would be 12.0 for Office 2007).

Option Explicit
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, 4) = "Date" Then
                oBookMark.Range.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
            ElseIf Right(oBookMark.Name, 6) = "Amount" 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
    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

This has been tested - in fact it was all created from scratch. I use both 2003 and 2007 and my code was more complex and had different requirements, so I created this Excel 2003 example to meet your requirements.
If you have any problems or something has not been explained well enough, let me know please.

 

[Macropod]

From what I can see, it doesn't seem anything is being done that can't be done more easily via a mailmerge except, perhaps, splitting the output into individual documents. For that, there are plenty of macros available (eg Individual merge letters - where you can also download a comprehensive mailmerge addin).

That said, if you want to create a document based on a specific template, modify the line:
oApp.Documents.Add
For example:
oApp.Documents.Add Template:="Template path & name"

 

[Eric Young]

Macropod,

I'm getting a "complie error: syntax error". The suggestion you made reads as follows:

If Dir(strTemplate) = "" Then
MsgBox strTemplate & " not found"
GoTo Tidy_Exit
End If
Set oDoc = oApp.Documents.Add Template:="c:\LetterCreator\WordTemplates\Test Letter.dot"
oApp.Selection.InsertFile strTemplate
' locate each bookmark
For Each oBookMark In oDoc.Bookmarks


The italized line is where I entered your suggestion. Any thoughts?

 

[Macropod]

Try:
Set oDoc = oApp.Documents.Add(Template:="c:\LetterCreator\WordTemplates\Test Letter.dot")

 

[Eric Young]

When I added your suggestion it kept the formatting of the template file however it was duplicating the text within the new document. So I took out the line just below it " oApp.Selection.InsertFile strTemplate:" and shazam. The only down side is the ability to designate what file to use as the template in the "control sheet" in excel will no longer function. If you have any thoughts about keeping the "control sheet" active while keeping the format from the template please let me know. Otherwise I greatly appreciate you assistance and I hope you have a wonderful day!!!

 

[Macropod]

You could use:
Set oDoc = oApp.Documents.Add(strTemplate)