(This post is a continuation of this post.)
My idea is to create a spreadsheet with Open Office Calc (if the spreadsheet does not already exists), write a form letter with Open Office Writer, merge the data in the spreadsheet with the form letter, and finally print individual documents, one for each student.
The procedure for doing this is clearly explained here. Note the field called “filename”.
There is only one problem with this, the option “Save as individual documents” doesn’t work any more. It is a recognised bug!
As far as I can see, MS Word 2003 does not have the option to save as individual documents.
—
One way to make this work is to do the mail merge manually in a macro. In a spreadsheet I have two columns, one for the name of the student and one for his form. The top row has “student” and “form” as heading for these columns.
A report template, called reportcardtemplate.doc has the text “<student>” and “<form>” and they will be replaced manually by the current row read in the spreadsheet. Actually, to make life simpler, I am reading the entire spreadsheet into an array first.
The manual mail merge will save the created documents into a folder bearing the name of their form and they will be named after the student. For example will John Lennon in form 9 have his report card saved in the folder “9″ and be called “John Lennon.doc”.
Here is the entire code:
Sub test01()
' better to redim the array as we go along
Dim arr(2000, 2) ' max 2000 students
' better to read the folder the current word document is sitting in
cmainfolder = "C:\Documents and Settings\Jan\Escritorio\BTS report card programs\creating 155 word documents\"
' better to ask for the template in a dialog box
ctemplate = "reportcardtemplate.doc"
' ask the user for a folder
cfolder = GetFolderName("Please choose a folder to put the form folders in")
'MsgBox cfolder
If cfolder = "" Then
MsgBox "fin"
Exit Sub
End If
' bring the spreadsheet into an array
' make an excel object
' add a reference to the Excel-library; use the menu Tools - References
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
' set it equal to the excel file
Set xlApp = CreateObject("Excel.Application")
' MsgBox cmainfolder + "students.xls"
Set xlWB = xlApp.Workbooks.Open(cmainfolder + "students.xls")
' go through each row from row 2 and put it into an array
r = 2
With xlWB.Worksheets(1)
While Cells(r, 1).Formula <> ""
arr(r - 1, 1) = Cells(r, 1).Value
arr(r - 1, 2) = Cells(r, 2).Value
r = r + 1
Wend
End With
' close
xlWB.Close False ' close the workbook without saving
xlApp.Quit ' close the Excel application
Set xlWB = Nothing
Set xlApp = Nothing
nstudents = r - 2
' go in a loop for number of records in the spreadsheet
For i = 1 To nstudents
' open the template
Documents.Open FileName:=cmainfolder + ctemplate
' replace <student> with arr(i,1), replace <form> with arr(i,2)
For Each myStoryRange In ActiveDocument.StoryRanges ' this is overkill
With myStoryRange.Find
.Text = "<student>"
.Replacement.Text = arr(i, 1)
.Wrap = wdFindContinue ' not needed since there is only one case, but does not hurt
.Execute Replace:=wdReplaceAll
.Text = "<form>"
.Replacement.Text = arr(i, 2)
.Wrap = wdFindContinue ' not needed since there is only one case, but does not hurt
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
' save the template in the folder arr(i,2) and call it arr(i,1).doc
' find the complete paths
If Right(cfolder, 1) <> "\" Then
cfolder = cfolder + "\"
End If
arr(i, 1) = cfolder + arr(i, 2) + "\" + arr(i, 1)
arr(i, 2) = cfolder + arr(i, 2)
' check if the folder arr(i,2) exists, if it does not then create it
If Len(Dir(arr(i, 2), vbDirectory)) = 0 Then
MkDir arr(i, 2)
End If
ActiveDocument.SaveAs (arr(i, 1))
ActiveDocument.Close
' end of loop
Next i
MsgBox "fin"
End Sub
What is missing from the above code is what is needed to ask the user for a folder: the general declarations, the function GetFolderName, and the procedure TargetFolderName, all given in the first post of this series.
