From Query in Access to Word

Raaff

New member
Local time
Today, 20:37
Joined
Jun 11, 2012
Messages
3
Hello!

I have been looking for a solution to do the following (mail merge is not an option, it must be a 1 click action):

1 - Query a set of adresses for a company (done)
2 - Export the query to fill the addressblock in a word template (done), but all in the same file (uh oh, that doesn't work!)

The problem I have now is that I can export the addressblock to the wordtemplate but it will open a new worddocument for each record in the recordset. I would like that to happen on a new page in the same document.

Can any of you help me with the following:
1 - after access/word has filled the first word template, insert a new template on the next page;
2 - fill the bookmarks on that new template with the 2nd record (then 3rd, 4th etc etc).

Here's how my code looks now:
Code:
Private Sub Command0_Click()
'Declare and set the Connection object
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection

'Declara and set the Recordset object
Dim rs As New ADODB.Recordset
rs.ActiveConnection = cnn

'Declare and set the SQL Statement to Export
Dim sSQL As String
sSQL = "SELECT * FROM tblAddresses))"

'Open the Recordset
rs.Open sSQL

    'Declare and set Word object variables
    Dim Wrd As New Word.Application
    Set Wrd = CreateObject("Word.Application")
    'Specify Path to Template
    Dim sMergeDoc As String
    sMergeDoc = Application.CurrentProject.Path & "\letter.dotx"

    'Open Word using Template and make Word visible
    Wrd.Documents.Add sMergeDoc
    Wrd.Visible = True

'Open a loop
Do
    'Declare Variables
    Dim sAdressering As String
    Dim sAdressering2 As String
    Dim sVoorletters As String
    Dim sAchternaam As String
    Dim sAdres As String
    Dim sPostcode As String
    Dim sPlaats As String
    Dim sAchternaam2 As String
    Dim sBrief As String
    
    'Build sAdressering
    sAdressering = rs.Fields("adressering")
    'Build sVoorletters As String
    sVoorletters = rs.Fields("Voorletters")
    'Build sAchternaam
    sAchternaam = rs.Fields("Achternaam")
    'Build sAdres
    sAdres = rs.Fields("Adres")
    'Build sPostcode
    sPostcode = rs.Fields("Postcode")
    'Build sPlaats
    sPlaats = rs.Fields("Plaatsnamen")
    'Build sAdressering2
    sAdressering2 = rs.Fields("heer/mevrouw")
    'Build sAchternaam2
    sAchternaam2 = rs.Fields("Achternaam")
    
    'Replace Bookmarks with Values
    With Wrd.ActiveDocument.Bookmarks
    .Item("Adressering").Range.Text = sAdressering
    .Item("Voorletters").Range.Text = sVoorletters
    .Item("Achternaam").Range.Text = sAchternaam
    .Item("Adres").Range.Text = sAdres
    .Item("Postcode").Range.Text = sPostcode
    .Item("Plaats").Range.Text = sPlaats
    .Item("Adressering2").Range.Text = sAdressering2
    .Item("Achternaam2").Range.Text = sAchternaam2
       
    rs.MoveNext
    
    End With
Loop Until rs.EOF()

'Clean up Code
Set Wrd = Nothing

End Sub

An help would be welcome! Thanks!
 
I have found a solution myself. For those interested here it is, although a bit tweaked to the contents of the word documents.

Code:
'Declare and set the Connection object
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection

'Declara and set the Recordset object
Dim rs As New ADODB.Recordset
rs.ActiveConnection = cnn

'Declare and set the SQL Statement to Export
Dim sSQL As String
sSQL = "SELECT * FROM tblNawgegevens WHERE ((ID < 4))"

'Open the Recordset
rs.Open sSQL

'Openen van de loop om meerdere brieven te laden

Do
    If rs.EOF = False Then
    'Declare and set Word object variables
    Dim Wrd As New Word.Application
    Set Wrd = CreateObject("Word.Application")
    'Specify Path to Template
    Dim sMergeDoc As String
    sMergeDoc = Application.CurrentProject.Path & "\letter.dotx"

    'Open Word using Template and make Word visible
    Wrd.Documents.Add sMergeDoc
    Wrd.Visible = True
    
        While rs.EOF = False
                
               'Declare Variables
                Dim sAdressering As String
                Dim sAdressering2 As String
                Dim sVoorletters As String
                Dim sAchternaam As String
                Dim sAdres As String
                Dim sPostcode As String
                Dim sPlaats As String
                Dim sAchternaam2 As String
                Dim sBrief As String
        
                'Build Strings
                sAdressering = rs.Fields("adressering")
                sVoorletters = rs.Fields("Voorletters")
                sAchternaam = rs.Fields("Achternaam")
                sAdres = rs.Fields("Adres")
                sPostcode = rs.Fields("Postcode")
                sPlaats = rs.Fields("Plaatsnamen")
                sAdressering2 = rs.Fields("heer/mevrouw")
                sAchternaam2 = rs.Fields("Achternaam")
        
                'Replace Bookmarks with Strings/Values
                With Wrd.ActiveDocument.Bookmarks
                    .Item("Adressering").Range.Text = sAdressering
                    .Item("Voorletters").Range.Text = sVoorletters
                    .Item("Achternaam").Range.Text = sAchternaam
                    .Item("Adres").Range.Text = sAdres
                    .Item("Postcode").Range.Text = sPostcode
                    .Item("Plaats").Range.Text = sPlaats
                    .Item("Adressering2").Range.Text = sAdressering2
                    .Item("Achternaam2").Range.Text = sAchternaam2
                    rs.MoveNext
                  If rs.EOF = False Then
                    Wrd.Selection.MoveDown Unit:=wdScreen, Count:=2
                    Wrd.Selection.EndKey Unit:=wdLine
                    Wrd.Selection.InsertBreak Type:=wdPageBreak
                    Wrd.Selection.InsertFile FileName:=sMergeDoc, ConfirmConversions:=False
                    
                    
                   Else
                   End If
                   
                End With
           Wend
        Else
        End If
Loop Until rs.EOF

'Clean up Code
Set Wrd = Nothing

End Sub
 

Users who are viewing this thread

Back
Top Bottom