# 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


----------



## Derek Brown

If you still need this (I see that you have had no replies, but you may have solved it), let me know and during this week-end I will reply with the answer.
I have used this method several times with the workbook containing the data to be automatically 'mapped' to bookmarks in a Word document - the bookmarks will have the same name/content as the workbook column-header.
The reason for checking first is that it will probably take about an hour to get everything together and I don't want to waste my time if you already have the answer.
It would also be useful to know which version of Office is being used.


----------



## samfolds

Hi,

Thank you so much for your replie.  I haven't found a way yet so I would definitely need your help.  I'm using office 2003.

I can't thank you enough for the time you'll be spending on this.  If you need any other information don't hesitate to contact me.

Samfolds


----------



## Derek Brown

First here are the instructions for creating the Word 'template' and the Excel control workbook. This may look complicated but it is not - just follow it step by step and you will then have an example that you can apply to your requirements.

Create a folder for the files. For the purpose of this test I will use drive C:
Create C:\Letter Creator
Create C:\Letter Creator\Word Templates
Create C:\Letter Creator\Documents

The actual names and locations are not important as they will be located by using a 'Control Sheet' in the workbook.

Create the Word 'template' for use by the process.
1. For the purpose of this example, enter the following exactly as it is written:

Address_Name
Address1
Address2

Letter_Date

Dear Salutation

Please note that you still owe Owed_Amount.

Yours Sincerely

2. Now convert some of those words to bookmarks:
Highlight Address_Name and select Insert | Bookmark (Alt + I + K)
In the dialog box enter the 'Bookmark name' as Address_Name and click 'Add'.
Click Tools | Options | View tab and make sure that 'Bookmarks' is ticked - click OK and you should see square brackets [] around the bookmark that you have just created. This is not essential for the process but it is useful to see where you have set the bookmarks.

Create bookmarks for Address1, Address2, Letter_Date, Salutation and Owed_Amount.

Note that you cannot use spaces in these name - instead, the underscore character aids readability. By keeping the text in the document, the bookmark name and the Excel column headers exactly the same, maintenance becomes easier.

Save the document as C:\Letter Creator\Word Templates\Test Letter.doc
Close the Word document.

Create the Excel Workbook:
Name the first worksheet as "Control Sheet"
In cell A1 enter "Template Folder" and make this bold
In cell B1 enter "C:\Letter Creator\Word Templates" (without the quotes of course)
Give cell B1 the name "Template_Folder". Do this by selecting cell B1 and typing that name in the "Name Box" (just above the heading of Column A) and press 'Enter' (very important to do that).
Similarly, Enter "Data worksheet" in A2; "Data Sheet" in B2 and give B2 the name "Data_Sheet".
And in A3 enter "Document Folder"; B3 enter "C:\Letter Creator\Documents" and give B3 the name "Document_Folder".

Name the second worksheet "Data Sheet" and in Row 1 enter the headings exactly as done for the Word bookmarks: Address_Name, Address1, Address2, Letter_Date, Salutation, Owed_Amount
It is important that these heading match the bookmark names exactly. The order is unimportant - the code will search for the bookmarks in the document and than try to match each name against the worksheet headings. All the bookmarks MUST be in the worksheet but you can have more headings than there are bookmarks (those not used would be ignored). Make the headings 'bold'.
Now in Row 2 and Row 3 enter values for each of the headings.
Save the workbook as "Letter Creator.xls".

Now you said that you wanted to have a specific name for the document so add a new column header (in my test it will be cell G1) "Document Name" and give this cell (G1) the name "Document_Name".
In cell G2 enter the formula ="Report-2010-"&E2&".doc" (E2 for example contains the Salutation) and copy it down to G3.
In H1 enter "Template Name" and give this the name "Template_Name". in cells H2 and H3 enter "Test Letter.doc".
Save the workbook

Now all you need is the VBA code to run the process - I will add that as another post.


----------



## Derek Brown

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).


		Code:
__


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.


----------



## samfolds

Thank you so much, I'm going to try to follow all of that step by step and see how it goes.

I'll try to get back to say how it worked out.

Thank you for your time!

Samfolds


----------



## samfolds

Hi Derek,

Just followed the whole procedure, but the code I pasted in the VBA window had a compile error : 



		Code:
__


Dim oApp As Word.Application

 
It says :"compile error: User-defined type not defined"

I don't know if that's of any help, but I am using a french version of Office.

I've never used excel to word code so I'm clueless on what to do.

Thanks in advance for your help.

Samfolds

Edit :Oh and I can't find the tool | reference tab to add the reference.


----------



## samfolds

samfolds said:


> Hi Derek,
> 
> Just followed the whole procedure, but the code I pasted in the VBA window had a compile error :
> 
> 
> 
> Code:
> __
> 
> 
> Dim oApp As Word.Application
> 
> 
> It says :"compile error: User-defined type not defined"
> 
> I don't know if that's of any help, but I am using a french version of Office.
> 
> I've never used excel to word code so I'm clueless on what to do.
> 
> Thanks in advance for your help.
> 
> Samfolds
> 
> Edit :Oh and I can't find the tool | reference tab to add the reference.


 

Ok nevermind about all that I had to browse in the Office folder to add the MSWORD.OBL file.  The Microsoft Word Object 11.0 Library then appeared.  Will try and run it and get back to you shrotly.

Thanks

Samfolds


----------



## samfolds

It worked beautifully .

Just so you know, I made a minor (very minor) change to your code :



		Rich (BB code):
__


 oDoc.SaveAs strWordDocumentName *& ".doc"
*    oDoc.Close

 
Before that, the file would save but didn't have any extension.  I still could open it as a word document, but I prefer having the right extension at sight.

Thanks a million for your time! This will help me big time.

Samfolds


----------



## Derek Brown

Thank you for the update and pleased that you now have the solution you were looking for.

Regarding the change you made to the filename - I think that you must have omitted it from the formula that I used:
="Report-2010-"&E2&".doc"
but it makes no difference as long as it works. However, as a rule, I try to put as much as possible in the control sheet because it is much easier for others to update - for example, when you upgrade to Office 2007/2010 you just need to make a simple change to the formula to change ".doc" to "docx".
Regards
Derek


----------



## 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


----------



## samfolds

You are right, I did forget to put it in the control sheet (Just corrected it). Furthermore, I totally agree that it is better to put lots of data in the control sheet as it's much easier to change something if I or others need to.

Thank you, hope this is going to help others in the future as well -_-

Samfolds


----------



## prasadavasare

samfolds said:


> Ok nevermind about all that I had to browse in the Office folder to add the MSWORD.OBL file.  The Microsoft Word Object 11.0 Library then appeared.  Will try and run it and get back to you shrotly.
> 
> Thanks
> 
> Samfolds


Hi Derek / Samford,

I am getting same VBA compile error 
Dim oApp As Word.ApplicationCan you please explain in detail what exactly I need to do to overcome this error?

Thanks and Warm Regards,
Prasad


----------



## Derek Brown

From #5:


> 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).


Did you set the reference to Word as per the above? As you will see, the version number (e.g. 11.0, 12.0) depends on the version of Office installed.


----------



## Macropod

Y'all might find the add-ins here useful: http://www.gmayor.com/individual_merge_letters.htm


----------



## prasadavasare

Hi Derek,

I am using office 2007 and Microsoft Word Object 12.0 Library is already checked in Tools|Reference. Please advise.

Thanks for your prompt reply.


----------



## prasadavasare

prasadavasare said:


> Hi Derek,
> 
> I am using office 2007 and Microsoft Word Object 12.0 Library is already checked in Tools|Reference. Please advise.
> 
> Thanks for your prompt reply.


oops!!! I cought my mistake.....I was looking at Microsoft Office Object 12.0 and not the Word. I really appologize for this Derek. The reason may be I am very new to VBA.

but now I am getting the second error further
Run-Time error 430
Class does not support Automation or does not support expected interface.

Can you please help on this error?


----------



## prasadavasare

prasadavasare said:


> oops!!! I cought my mistake.....I was looking at Microsoft Office Object 12.0 and not the Word. I really appologize for this Derek. The reason may be I am very new to VBA.
> 
> but now I am getting the second error further
> Run-Time error 430
> Class does not support Automation or does not support expected interface.
> 
> Can you please help on this error?


The error is on the below line:
'Set oApp = CreateObject("Word Application")
Set oApp = New Word.Application


----------



## Derek Brown

Try:


		Code:
__


Set oApp = CreateObject("Word.Application")

That is, with the "."


----------



## prasadavasare

Derek Brown said:


> Try:
> 
> 
> Code:
> __
> 
> 
> Set oApp = CreateObject("Word.Application")
> 
> That is, with the "."


Now I am getting different error on same line:
Run time error'13'
type mismatch


----------



## prasadavasare

prasadavasare said:


> Now I am getting different error on same line:
> Run time error'13'
> type mismatch


Hi Derek,

I tried once more with the procedure. 
When I use: Set oApp = New Word.Application I am getting below error
Run-Time Error 430
Class does not support Automation or does not support expected interface

When I use: Set oApp = CreateObject("Word Application") I am getting below error
Run-Time Error 429
ActiveX componant can't create object

Your help would be much appriciated in this situation.

Thank you for your time.


----------



## 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

Hi,
Can anybody resolve this problem....I need to fixed this.....

Thank you,


----------



## Derek Brown

Could you post the code that you are using, please - it is sometimes not easy to determine an error when looking at only part of the code. I can then try it on my system to see if I can find a solution.
Also please confirm the versions that you are using - XP and Office 2007?


----------



## prasadavasare

Thank You Derek...I am using Excel 2007.....I am getting Run time error 13 Type-Mismatch.............. Here is the code I am 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
'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.


----------



## Derek Brown

I have copied the code into an Excel workbook and it "compiles" OK.
I need to create the files, worksheets etc. before I can try running it.
From your last post it seems that you are back to the original error at the following line:


		Code:
__


Set oApp = CreateObject("Word.Application")

Could you confirm that my understanding is correct, please?
Also, could you let me know the 'References' (Tools/References) that have been selected AND the order that they appear (sometimes that is important).
Are you running on Windows XP?


----------



## prasadavasare

Hi Derek,
Yes....you are correct I am getting the error on same line. I have checked Visual Basic for Application, Microsoft Excel 12.0 Object Library, OLE Automation, Microsoft Office 12.0 Object Library,Microsoft ActiveX data objects 6.0 Library, Microsoft Word 12.0 Object Library, Microsoft Shell Controls and Automation.
I am using windows Vista


----------



## Derek Brown

Thanks - leave it with me for a few hours and I will set up my files and worksheets and see what I can find.


----------



## Derek Brown

Right, this is intriguing ....
First, some background - the code originally was used and tested using both Office 2003 and Office 2007 on Windows XP. I am now using Windows 7 Ultimate 64-bit and Office 2010 32-bit (64-bit Office 2010 is troublesome).
I copied the code that you posted, set the 'References' exactly as you have set and .... it worked first time without any problem.
The only differences are that you are using Vista and I would have set fewer 'References' when I originally tested the code. That is assuming that this is the only code in the workbook.
For this particular code to run you only need "Visual Basic for Application, Microsoft Excel 12.0 Object Library and Microsoft Word 12.0 Object Library" to be set.
My suggestion is to remove the unwanted references, save the workbook, close and then re-open the workbook, compile the code and try again. If you cannot remove all the references because they are needed by other code in the workbook, do as I have just described but ensure that the three 'essential' ones for this code are at the top of the list.
Try that first and let me know how it goes.


----------



## prasadavasare

Hi Derek,

Thank you very much for your efforts....but Bad news.....I did try with just the 3 references you have given....still not working....still getting the same error...the same error....


----------



## prasadavasare

Hi Derek,
I have done some changes in the code....that may be resolving the problem for the line for which I am getting error....but now I am facing the new error on the other line....can you please check and let me know:

The line I have changed is: 
Dim oApp As Object
Dim oDoc As Object


The error now I am facing in line is:
For Each oBookMark In oDoc.Bookmarks

The error is Type mismatch


I Hope this might help you in solving the issue...the entire code I am pasting again for better picture

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 Object
Dim oBookMark As Word.Bookmark
Dim oDoc As Object
'
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")
oApp.Visible = True
'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.


----------



## Derek Brown

That change does work OK for me.
Unfortuinately I don't have Vista and Excel 2007 available to try with that, but I wonder if we are getting closer ....
Try changing:


		Code:
__


Dim oBookMark As Word.Bookmark

to:


		Code:
__


Dim oBookMark As Object

That too works for me and by not declaring the application at that point, means that we are using 'late binding'.
By making this change, it is no long necessary to have the 'Reference' to Word so you could also try removing that.


----------



## 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!!!





Derek Brown said:


> 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).
> 
> 
> Code:
> __
> 
> 
> 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)


----------



## 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


----------



## Eric Young

It's perfect, Thank you so much!!!!


----------



## GeneralOb

This is nearly perfect.  The trouble I’m having now though is that because this uses Bookmarks, I have to use Cross-reference fields in my template.

However no matter what I’ve tried so far I can’t seem to get the Cross-reference fields to update correctly!  I think this might be because the code replaces the bookmark field with data and therefore when the Cross-reference fields try to update with the same data, the reference source is not found as it no longer is a bookmark.

Please could someone let me know if my understanding of this is correct and hopefully help me find a way around this?

Thanks in advance.


----------



## Macropod

To retain the bookmarks so the cross-references can be updated:
1. Add a new variable - Dim BmkRng As Word.Range
2. Change the 'For Each oBookMark In oDoc.Bookmarks' loop to:


		Code:
__


    For Each oBookMark In oDoc.Bookmarks
        With oBookMark
            Set objX = wsData.Rows(1).Find(.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                With BmkRng
                    If Right(.Name, 4) = "Date" Then
                        .Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
                    ElseIf Right(.Name, 6) = "Amount" Then
                        .Text = Format(wsData.Cells(rng2.Row, objX.Column), "£#,##0.00")
                    Else
                        .Text = wsData.Cells(rng2.Row, objX.Column)
                    End If
                End With
                oDoc.Bookmarks.Add .Name, BmkRng
            Else
                MsgBox "Bookmark '" & .Name & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next oBookMark
    oDoc.Fields.Update


----------



## GeneralOb

Thanks for responding Macropod.  I’ve made the changes as instructed but unfortunately get the following error message:

Compile error:
Method or data member not found

After I click OK to make the error message go away the following text is automatically selected.  I’ve tried following the code and comparing it to the original but cannot see why this part would be affected as it seems to be close enough to the original.

Any chance you could take another look?

Thanks



		Code:
__


    For Each oBookMark In oDoc.Bookmarks
        With oBookMark
            Set objX = wsData.Rows(1).Find(.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                With BmkRng
                    If Right(.[B][COLOR=#ff0000]Name[/COLOR][/B], 4) = "Date" Then
                        .Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
                    ElseIf Right(.Name, 6) = "Amount" Then
                        .Text = Format(wsData.Cells(rng2.Row, objX.Column), "£#,##0.00")
                    Else
                        .Text = wsData.Cells(rng2.Row, objX.Column)
                    End If
                End With
                oDoc.Bookmarks.Add .Name, BmkRng
            Else
                MsgBox "Bookmark '" & .Name & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next oBookMark
    oDoc.Fields.Update


----------



## Macropod

Try:


		Code:
__


    For Each oBookMark In oDoc.Bookmarks
        With oBookMark
            Set objX = wsData.Rows(1).Find(.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                If Right(.Name, 4) = "Date" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
                ElseIf Right(.Name, 6) = "Amount" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "£#,##0.00")
                Else
                    BmkRng.Text = wsData.Cells(rng2.Row, objX.Column)
                End If
                oDoc.Bookmarks.Add .Name, BmkRng
            Else
                MsgBox "Bookmark '" & .Name & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next oBookMark
    oDoc.Fields.Update


----------



## GeneralOb

Hi Macropod

Still no luck.  This time the error returned is:

Run-time error ‘5825’:
Object has been deleted.

When I hover over the .Name, the display message is:

.Name = Object has been deleted.

Thanks again.



		Code:
__


    For Each oBookMark In oDoc.Bookmarks        With oBookMark
            Set objX = wsData.Rows(1).Find(.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                If Right(.Name, 4) = "Date" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
                ElseIf Right(.Name, 6) = "Amount" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "£#,##0.00")
                Else
                    BmkRng.Text = wsData.Cells(rng2.Row, objX.Column)
                End If
[COLOR=#ff0000]                oDoc.Bookmarks.Add [B].Name[/B], BmkRng[/COLOR]
            Else
                MsgBox "Bookmark '" & .Name & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next oBookMark
    oDoc.Fields.Update


----------



## Macropod

Try :
1. Add a new variable - Dim StrBmk As String
2. Insert 'StrBmk = .Name' after 'Set BmkRng = .Range'
3. Change 'oDoc.Bookmarks.Add .Name, BmkRng' to 'oDoc.Bookmarks.Add StrBmk, BmkRng'

Memo to self: Don't try to help modify someone else's code without data for testing.


----------



## GeneralOb

Thanks Macropod

No error message this time but it seems that the loop just keeps on looping.  I think it might be because the first oBookMark remains in the document and therefore keeps looping back on itself.

Any ideas of how we can cycle through all of the Bookmarks in the Word Template?


----------



## Macropod

You might need to use something like:


		Code:
__


Dim i As Long
    For i = oDoc.Bookmarks.Count To 1 Step -1
        With oDoc.Bookmarks(i)
            Set objX = wsData.Rows(1).Find(.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                If Right(.Name, 4) = "Date" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
                ElseIf Right(.Name, 6) = "Amount" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "£#,##0.00")
                Else
                    BmkRng.Text = wsData.Cells(rng2.Row, objX.Column)
                End If
                oDoc.Bookmarks.Add .Name, BmkRng
            Else
                MsgBox "Bookmark '" & .Name & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next


----------



## GeneralOb

Hi Macropod

Still no success and the worst part is that I'm not sure if I understand what is going on here!!

Sorry this is a long post. I’m just trying to add as much detail as possible as I get the feeling that it’s just a slight tweak/s that is required.

I’m looking to initially add format switches manually to the Bookmarks in the actual Word Template and hopefully once the code runs it will fill the Bookmarks in the document with data in the same format as the switches in the Word Template. I’ll also have Cross-references to the Bookmarks in the Word Template which will update with each of the values of the Word Bookmarks and ideally none of the Bookmark or Cross-reference fields will be present in the output document although it won’t matter too much if they are.

Some of the code in this loop had formatting instructions included so I’ve decided to remove those bits to make the code clearer. 

After deleting out the formatting code this is what is left:


		Code:
__


Dim i As Long

    For i = oDoc.Bookmarks.Count To 1 Step -1
        With oDoc.Bookmarks(i)
            Set objX = wsData.Rows(1).Find(.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                   [COLOR=#008000]BmkRng.Text = wsData.Cells(rng2.Row, objX.Column)[/COLOR]
               [COLOR=#ff0000]oDoc.Bookmarks.Add .Name, BmkRng[/COLOR]
            Else
                MsgBox "Bookmark '" & .Name & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next


As I step through the code line by line everything appears to be working great up to and including the green line.
If we assume:

· there are six Bookmarks in the Word Template
· the first Bookmark is Surname
· the first Surname in the Excel Data Sheet is Smith

then whilst I’m on the green line and directly before I step onto the red line we have the following values:


		Code:
__


i  = 6
oDoc.Bookmarks.Count = 6
oDoc.Bookmarks(i) = 6
objX = Surname
.Name = Surname
BmkRng = Surname
.Range = Surname
BmkRng.Text = Surname

However once I step onto the red line the following values appear:


		Code:
__


i  = 6
[B]oDoc.Bookmarks.Count = 5[/B]
oDoc.Bookmarks(i) = 6
objX = Surname
[B].Name = Object has been deleted.[/B]
[B]BmkRng = Smith[/B]
[B].Range = Object has been deleted.[/B]
[B]BmkRng.Text = Smith[/B]

The red line is also the last line I can run through. If I try to go onto the next line of code the following error message appears with the red line highlighted once I click Debug:

*Run-time error ‘5825’:*
*Object has been deleted.*

I assume that the following line replaces the entire Bookmark (Surname) in the Word Document with the Data Value (Smith):


		Code:
__


[COLOR=#008000]BmkRng.Text = wsData.Cells(rng2.Row, objX.Column)[/COLOR]

Then on the following line when the same Bookmark (Surname) needs to be re-inserted, the code is unable to find the correct location to insert the Bookmark as it has been replaced with the Data Value (Smith):


		Code:
__


[COLOR=#ff0000]oDoc.Bookmarks.Add .Name, BmkRng[/COLOR]

I think what might be required is that before each Bookmark (Surname) is replaced with the Data Value (Smith), all of the Cross-reference fields for that Bookmark (Surname) need to be located. Once all of the relevant Cross-reference fields have been found, the Bookmark (Surname) needs to be replaced with the Data Value (Smith) and then the Cross-reference fields somehow re-inserted or re-linked back to the Data Value (Smith)

This is my take on the issue but I’m quite new to all of this so it’s quite likely that I have gone wildly off on a tangent!

Either way if you’re able to help in any way it would be very much appreciated it. Also, thanks for your help so far and HAPPY NEW YEAR!!


----------



## 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


----------



## Macropod

I think the issue is that, upon updating, the bookmark and, hence, its name, are both deleted. Try:


		Code:
__


Dim i As Long, StrBmk As String
    For i = oDoc.Bookmarks.Count To 1 Step -1
        With oDoc.Bookmarks(i)
            StrBmk = .Name
            Set objX = wsData.Rows(1).Find(StrBmk, LookIn:=xlValues, LookAt:=xlWhole)
            If Not objX Is Nothing Then
            ' found
                Set BmkRng = .Range
                If Right(StrBmk, 4) = "Date" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "dd mmmm yyyy")
                ElseIf Right(StrBmk, 6) = "Amount" Then
                    BmkRng.Text = Format(wsData.Cells(rng2.Row, objX.Column), "£#,##0.00")
                Else
                    BmkRng.Text = wsData.Cells(rng2.Row, objX.Column)
                End If
                oDoc.Bookmarks.Add StrBmk, BmkRng
            Else
                MsgBox "Bookmark '" & StrBmk & "' not found", vbOKOnly + vbCritical, "Error"
                GoTo Tidy_Exit
            End If
        End With
    Next


----------



## venkateshr

Hi, Thank you very much for the code and procedure. You were been great help for me today. Can you please also tell me how to activate this code in command button (for example- if i click the command button this code should work) can you please help me......today is my first day in office and i have to do this....pls help me ASAP


----------



## Macropod

Have you tried adding the code (except for the opening Sub & ending End Sub lines) to your command button, or simply calling the existing sub from your command button? Either approach should work.


----------



## venkateshr

Thanks for your reply Paul, its working now....

Can you also please suggest me how can i learn writing macro. 

Regards,
Venkatesh


----------



## Macropod

You could buy some vba programming textbooks for whatever Office applications you're concerned with (eg Word, Excel Access), do a course, and/or study the code you'll find in forums like this one.


----------



## venkateshr

Macropod said:


> You could buy some vba programming textbooks for whatever Office applications you're concerned with (eg Word, Excel Access), do a course, and/or study the code you'll find in forums like this one.



Dear Friends,

I tried this macro for another file by following all the steps i am getting "Runtime error 424 Object required". when i checked debug the below mentioned code is highlighted in yellow colour.. can anybody help me to solve this pls

strDocumentFolder = wsControl.[Document_Folder].Value

Below the excel file details which i have maintained in data sheet for your referece

Coloum AColoum BColoum CColoum DColoum EColoum FColoum GColoum HColoum IColoum JFirst_NameRole Hired ForNotice_PeriodDate of JoiningBasic_SalaryShift_allowanceAnnualMedicalDocument NameTemplate NameBoscoSenior Executive3022-Oct-1330,000.001,000.001210Offer Proposal Form.docxOffer Proposal Form.docx

and the control sheet contains the below details

Template FolderD:\Macro Employee Contract Advise\Letter CreatorWord TemplatesData worksheetData SheetDocument FolderD:\Macro Employee Contract Advise\Letter CreatorDocuments

Regards,
Venkatesh


----------



## Macropod

Are you _sure _you've followed _all _of the steps in posts 4 & 5? The error message suggests you haven't.


----------



## djsban

Macropod said:


> Are you _sure _you've followed _all _of the steps in posts 4 & 5? The error message suggests you haven't.



I agree with *venkateshr* - I've followed all of the instructions in this post and get the same error.

This would be a great tool and I'd be really interested in anyone's thoughts on what is causing this error....and how I can fix it of course! 

Any help appreciated!

Full code is copied below:


		Code:
__


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


----------



## Macropod

Frankly, I don't have time to go through all the steps required to implement, test & (probably not) debug the code. The original code, when implemented as per the directions given, worked. I later supplied some enhancements.

IMHO, though, the entire project would be better managed via a mailmerge, perhaps coupled with a document-splitter macro (see, for example Document Splitter). Alternatively, one could just as easily use one of the Many-to-One Mail Merge add-ins, from:
Graham Mayor at http://www.gmayor.com/ManyToOne.htm; or
Doug Robbins at https://skydrive.live.com/?cid=5aed...!cid=5AEDCB43615E886B&id=5AEDCB43615E886B!566


----------



## osnola ibax

Hi there, I have followed all the steps, took about an hour maybe. Its brilliant. However, is there any amendment I could make that would just allow me to merge one row of data from the data spreadsheet at a time. In other words select from an active row or something like that.


----------



## 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


----------



## drm027

Hello, I know this is a pretty old thread, but I am hoping someone can help me.  
I used the code and it worked well for me, except the newly created word doc does not maintain the formatting of the original word doc.  For example the template is sized "Legal" and the page margins are "Narrow".  The new doc is sized "Letter" and "Normal" margins.

Other than that the VBA works great for me!

Thanks for some suggestions.


----------



## Macropod

The problem you're encountering is related to these lines:
Set oDoc = oApp.Documents.Add
oApp.Selection.InsertFile strTemplate
The Add method accepts a template name as a parameter. However, when no template is specified, Word's 'Normal' template is used. It seems the original code was trying to get around this via .InsertFile strTemplate. If strTemplate is an actual template name, however, you'd do better to replace both those lines with:
Set oDoc = oApp.Documents.Add(strTemplate)
Alternatively, you need to specify the appropriate template's path & name. For example:
Set oDoc = oApp.Documents.Add("C:\Templates\Report Template.dotm")
Of course, if, as is often the case, someone merely modified a document so that its layout no longer reflects its own template, you'll need to take an unused copy of one of those documents and save it as a template.


----------



## drm027

That worked out perfectly!  Thank you for your help.  
I'm new to VBA, but I'm finding that it can do some pretty incredible things to make life easier!


----------



## Dark8

Hi All,

Just been reading this thread and its been an absolute godsend!  

In my case, i had a form that had fields such as address, name, amounts etc that needed to be completed.  I have been able to import those from Excel perfectly using the VBA code.  However, the letter had write restrictions on it, and was a "form" only.  Some portions of the form still need to be completed manually and i wanted to know what code i could add to the Excel VBA to reinstate the restrictions after the initial data was copied across?

Any assistance would be greatly appreciated!  

Thanks!


----------



## Macropod

Dark8 said:


> i wanted to know what code i could add to the Excel VBA to reinstate the restrictions after the initial data was copied across?


The core code for this would be something like:


		Code:
__


Sub Demo()
Application.ScreenUpdating = False
Const Pwd As String = ""
With ActiveDocument
  If .ProtectionType <> wdNoProtection Then .Unprotect Password:=Pwd
  'Do your processing here
  .Protect Type:=wdAllowOnlyFormFields, NoReset:=False, Password:=Pwd
End With
Application.ScreenUpdating = True
End Sub

Simply add the password, if any, between the "".


----------



## Dark8

thanks!


----------



## Delphy010

Derek Brown said:


> 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).
> 
> 
> Code:
> __
> 
> 
> 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.





Just want to say a big THANK YOU for your code back in 2010, its a great help to what I want to do! I've also combined it with a vlookup function so that data entry for the data of the letter is automated.

Anyway thanks a lot!


----------



## lizl heunis

Hi Derek

i know this post is old, but i used your advise (step by step) and it works perfectly, i was just wondering if you perhaps have a solution for the Word doc keeping it's formatting when it creates from the template
it's not the dates or percentages i'm having an issue with, for some reason when the macro creates and saves the word docs, it adds spaces etc., the template file of course stays the same, any ideas

many thanks once again


----------



## sztibor

Hello Derek,
I know it's an old post, but I found it googling my problem and suits my needs almost perfectly. Very nice code and helpful explanation.
I am trying to implement into it the option to create the word documents for only certain rows (asked as imput, or stored in a cell, like start line - finish line).
I am quite new to VBA, so I have problems figuring it out. Could you take a look at it and help me with some suggestions?
Many thanks,
Tibor


----------

