bluetongue
Registered User.
- Local time
- Tomorrow, 02:58
- Joined
- Jul 15, 2004
- Messages
- 34
The code below shows how to create a mailmerge datasource to include details from several records in a single letter.
Code:
Option Compare Database
Option Explicit
Sub createMailMergeData()
' an MSWord mailmerge will create a new document from each record
' this code combines multiple records into a single record so that the
' repeated groups are formatted as a tabbed list in the mailmerge document.
'
' combine multiple records into a single mailmerge
' requires an empty table called tblMailMerge with the following fields:
' Company ID long integer
' CompanyName text
' addressLine1 text
' addressLine2 text
' townStatePC text (town, state and postcode)
' Products memo
'
' create a query to select the records required
' include in the SQL the ORDER BY clause
' ORDER BY CompanyID, PRODUCTID
' to force all company records to be consecutive
'
' the CompanyID,Name and address fields are stored in variables
' while the memo field combines ProductID and ProductName with tab and line feed characters
' a new record is written to tblMailMerge when the CompanyID changes
'
' Author: bluetongue
'
Dim dbThis As Database
Dim rsIn As Recordset
Dim rsOut As Recordset
Dim lngCompanyID As Long
Dim strCompanyName As String
Dim strAddressLine1 As String
Dim strAddressLine2 As String
Dim strTownStatePC As String
Dim strProducts As String
Set dbThis = CurrentDb
Set rsIn = dbThis.OpenRecordset("qryInputs", dbOpenDynaset, dbReadOnly)
rsIn.MoveLast
rsIn.MoveFirst
Set rsOut = dbThis.OpenRecordset("tblMailMerge")
Do While Not rsIn.EOF
With rsIn
If lngCompanyID <> .Fields("CompanyID") Then
With rsOut
.AddNew
.Fields("CompanyID") = lngCompanyID
.Fields("Sponsor Name") = strCompanyName
.Fields("Address Line1") = strAddressLine1
.Fields("Address Line2") = strAddressLine2
.Fields("townStatePC") = strTownStatePC
.Fields("Products") = strProducts
If lngCompanyID <> 0 Then
.Update
End If
End With
lngCompanyID = .Fields("CompanyID")
strCompanyName = .Fields("Sponsor Name")
strAddressLine1 = .Fields("Address Line1")
strAddressLine2 = Nz(.Fields("Address Line2"))
strTownStatePC = .Fields("townStatePC")
strProducts = .Fields("PRODUCTID") & Chr(9) & .Fields("ARTGLabelName")
Else
strProducts = strProducts & Chr(13) & .Fields("PRODUCTID") & Chr(9) & .Fields("ARTGLabelName")
End If
.MoveNext
End With
Loop
' process last record
With rsOut
.AddNew
.Fields("CompanyID") = lngCompanyID
.Fields("Sponsor Name") = strCompanyName
.Fields("Address Line1") = strAddressLine1
.Fields("Address Line2") = strAddressLine2
.Fields("townStatePC") = strTownStatePC
.Fields("Products") = strProducts
.Update
End With
Set rsIn = Nothing
Set rsOut = Nothing
Set dbThis = Nothing
End Sub