Mail Merge VB Access to Word to Print Multiple Records Via Button

[kirkus84]

I am currently trying to do a multiple record mail merge through a query via a command button on a form. The query basically displays customers who have said yes to privacy. The user inputs a date into txtDate on frmDate and the clicks "View Queried Privacy Records" Once they click this it opens the query form frmPrivacy which then has a command button cmdMailmerge to perform the mail merge and print the records that result from that query. (I would prefer to perform the query and mail merge/print without having to go frmPrivacy)

The command button has the following code:


Private Sub cmdMailmerge_Click()

On Error GoTo MergeButton_Err


'Start Microsoft Word
Dim objWord As Word.Application
Set objWord = CreateObject("Word.Application")

With objWord
'Make the application visible.
.Visible = True

'Open the document.
.Documents.Open ("H:\privacymerge.dot")

'Move to each bookmark and insert text from the form.
.ActiveDocument.Bookmarks("Title").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![Title]))
.ActiveDocument.Bookmarks("FirstName").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![FirstName]))
.ActiveDocument.Bookmarks("LastName").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![LastName]))
.ActiveDocument.Bookmarks("Address1").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![Address1]))
.ActiveDocument.Bookmarks("Address2").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![Address2]))
.ActiveDocument.Bookmarks("State").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![State]))
.ActiveDocument.Bookmarks("PostCode").Select
.Selection.Text = (CStr(Forms![frmPrivacy]![Postcode]))

End With


'Print the document in the foreground so Microsoft Word will not close
'until the document finishes printing.
objWord.ActiveDocument.PrintOut
Do While objWord.BackgroundPrintingStatus > 0
Loop

'Close the document without saving changes.
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

'Quit Microsoft Word and release the object variable.
objWord.Quit
Set objWord = CreateObject("Word.Application")

Exit Sub

MergeButton_Err:
'If a field on the form is empty, remove the bookmark text, and
'continue.
If Err.Number = 94 Then
objWord.Selection.Text = ""
Resume Next

End If

Exit Sub

End Sub

The above code only mail merges and prints the record that the form is currently on, so one record at a time. I need the mail merge to print all records when the query is run. I was thinking of doing a loop with the number of records so it prints all records but have no idea of how to go about it. Any ideas or suggestions?

[AdrianJ1980]

Hi,

I've used the attached code in a database i made ages ago - i can't remember where it came from.

Private Sub RunMergeLetters_Click()
 
 
    Dim strPath As String
    Dim strDataSource As String
    Dim conTemplate As String
    Dim conQuery As String
 
    Dim doc As Word.Document
    Dim wrdApp As Word.Application
 
    conTemplate = "Confirmationletter.doc"
    conQuery = "qry 2-1 Letter Query"
 
    On Error GoTo HandleErrors
    ' Delete the rtf file, if it already exists.
    strPath = "C:\My Computer\<file path>\"
    strDataSource = strPath & conQuery & ".doc"
    Kill strDataSource
 
    ' Export the data to rtf format.
    DoCmd.OutputTo acOutputQuery, conQuery, _
     acFormatRTF, strDataSource, False
 
    ' Start Word using the mail merge template.
    Set wrdApp = New Word.Application
    Set doc = wrdApp.Documents.Add(strPath & conTemplate)
 
    ' Do the mail merge to a new document.
    With doc.MailMerge
        .OpenDataSource Name:=strDataSource
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        If .State = wdMainAndDataSource Then
            .Execute
        End If
    End With
 
    ' Display the mail merge document.
    wrdApp.Visible = True
 
 
ExitHere:
    Set doc = Nothing
    Set wrdApp = Nothing
    Set doc2 = Nothing
    Set wrdApp2 = Nothing
    Exit Sub
 
HandleErrors:
    Select Case Err.Number
        Case 53         ' File not found.
            Resume Next
        Case Else
            MsgBox Err.Number & ": " & Err.Description
            Resume ExitHere
    End Select
 
        End If
 
End Sub

This code merges all records in a query to a merge letter, provided the merge letter has the correct fields set up.

I don't know vb code well enough to contribute much, but I hope this helps.