Access data to WORD

[wverweij]

Hi,

Maybe already solved or asked before but i'm desperate.

I'm strugling with transferring data from access to ä word template.

1. transferring single data fields works okay, with bookmarks etc.

2. transferring multiple records (e.g. orderlines) to a WORD template fails. The # of multiple records are variable. So could not be defined upfront how may records i have to transfer.

I tried to transfer the data in a word table both with bookmarks and with merge fields. The result was that all data was placed in de first cell of the table in WORD.

Please give me some help. Setting up de WORD template combining with the VBA code.

See VBA code:

Private Sub Knop17_Click()
On Error GoTo Err_knop17_Click

Dim sreportname As String
Dim scurrentdir As String
Dim stemplatedir As String
Dim stemplatename As String
Dim ObjWord As Word.Application
Dim ObjDoc As Word.Document
Dim bm As Object

scurrentdir = "\\mijnasp\ijslandtours\data\data2\ijsland tours\reisbescheiden\accommodatielijsten\"
stemplatedir = scurrentdir + "template\"
sreportname = scurrentdir & Me.rtBoekingID & " - " & Me.bkPartyOmschrijving & " - routebeschrijving.doc"
stemplatename = stemplatedir & "Route-template - kopie.dotx"

'check if template still existst

'check if reportname already exists

'open word
On Error Resume Next
' check if word is already running
Set ObjWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set ObjWord = CreateObject("Word.Application")
End If
On Error GoTo Err_knop17_Click

' open template as a new doc
Set ObjDoc = ObjWord.Documents.Add(Template:=stemplatename, NewTemplate:=False)

'fill data in bookmarks
ObjWord.Selection.Goto What:=wdGoToBookmark, Name:="Boekingnr"
ObjWord.Selection.TypeText Text:=CStr(rtBoekingID)

ObjWord.Selection.Goto What:=wdGoToBookmark, Name:="Reizigers"
ObjWord.Selection.TypeText Text:=Trim(bkPartyOmschrijving)

ObjWord.Selection.Goto What:=wdGoToBookmark, Name:="Reis"
ObjWord.Selection.TypeText Text:=Trim(bkReisnaam)

ObjWord.Selection.Goto What:=wdGoToBookmark, Name:="Aantal"
ObjWord.Selection.TypeText Text:=CStr(bkPAX)

ObjWord.Selection.Goto What:=wdGoToBookmark, Name:="Begdatum"
ObjWord.Selection.TypeText Text:=CStr(bkBegindatum)

ObjWord.Selection.Goto What:=wdGoToBookmark, Name:="Einddatum"
ObjWord.Selection.TypeText Text:=CStr(bkEinddatum)

'-------------------- repeating block voor routebeschrijvingen

'1. run query voor verzamelen alle records

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strRecords As String
Dim sqlstr As String

sqlstr = "SELECT tblRoute.rtBoekingID, tblKlanten.klBedrijfsnaam, tblReissegmenten.rsNaam, tblReissegmenten.rsCode, tblBoekingssegmenten.bsAankomstdatum, tblBoekingssegmenten.bsVertrekdatum, tblRoute.rtRoute, tblBoekingen.bkBegindatum, tblBoekingen.bkEinddatum, tblBoekingen.bkReisnaam, tblBoekingen.bkPAX, tblBoekingen.bkPartyOmschrijving, tblReissegmenten.rsAdres1, tblReissegmenten.rsTelnr, tblReissegmenten.rsPlaats FROM ((tblRoute INNER JOIN (tblReissegmenten INNER JOIN tblBoekingssegmenten ON tblReissegmenten.rsReissegmentID = tblBoekingssegmenten.bsReissegmentID) ON tblRoute.rtBoekingssegmentID = tblBoekingssegmenten.bsBoekingssegmentID) INNER JOIN tblBoekingen ON tblRoute.rtBoekingID = tblBoekingen.bkBoekingID) INNER JOIN tblKlanten ON tblBoekingen.bkKlantID = tblKlanten.klKlantID WHERE (((tblRoute.rtBoekingID)=" & rtBoekingID & ") AND ((tblBoekingssegmenten.bsVoucher)=False))"
Set db = CurrentDb()
Set rs = db.OpenRecordset(sqlstr, dbOpenDynaset)

If rs.RecordCount > 0 Then

'loop thru all the records
While Not rs.EOF
strRecords = strRecords & rs.Fields("rsNaam").Value & Chr(9)
strRecords = strRecords & rs.Fields("rsTelnr").Value & Chr(9)
strRecords = strRecords & CStr(rs.Fields("bsAankomstdatum").Value) & Chr(9)
strRecords = strRecords & rs.Fields("rsAdres1").Value & Chr(9)
strRecords = strRecords & CStr(rs.Fields("bsVertrekdatum").Value) & Chr(9)
strRecords = strRecords & rs.Fields("rsPlaats").Value & Chr(9) & Chr(9)
strRecords = strRecords & rs.Fields("rtRoute").Value & vbCrLf
rs.MoveNext
Wend
rs.Close
Set rs = Nothing

'-----------------------------------

ObjDoc.Bookmarks("StartBlock_Route").Select
ObjWord.Selection.Text = strRecords & ""

'--------------------

End If

'Update fields in Word document and activate it
ObjWord.Visible = True
ObjWord.Selection.WholeStory
ObjWord.Selection.Fields.Update
ObjWord.ActiveDocument.SaveAs2 sreportname
ObjWord.Activate
ObjWord.Selection.EndKey Unit:=wdStory
ObjWord.ActiveWindow.WindowState = 0

Exit_knop17_Click:
Set ObjWord = Nothing
'ObjDoc.Close True
Set ObjDoc = Nothing
Exit Sub

Err_knop17_Click:
MsgBox Err.Description
Resume Exit_knop17_Click

End Sub


Regards and thanks,

Wouter

 

[wverweij]

Hi Pat,

I thought I did it in de VBA code as you described. Hope you can validate.

1. set up the sql statement
2. gather all the data inclusive tabs en crlf (i hope i did okay)
3. select the table
4. transfer the data to the table

The output is that all multiple records placed in the first cell of the selected table.

maybe could you give me a working example?

thanks

regards


Wouter Verweij