Hey allemaal,
Ik ben deze week beziggeweest met het maken van een access database voor op onze afdeling. De database bestaat uit een formulier om data toe te voegen (verder niet zo heel spannend).
Mijn idee is nu om aan de hand van een knop in Access een SQL query te draaien (even simpel: SELECT * FROM Deployments ORDER BY ID DESC) en deze via een recordset overzetten naar een bestaand Word-document. Dit lukt allemaal door de tabel in mijn document te voorzien van fields.
Het probleem is nu: de recordset plaats enkel de eerste rij in mijn tabel in Word, terwijl er - momenteel - twee testrijen in de database staan.
Mijn vraag is: hoe zorg je ervoor dat je via VBA in Access een nieuwe rij aan de tabel in Word laat toevoegen wanneer er meer dan een één record opgevraagd wordt vanuit de query?
Ik heb nu dit (je zou zeggen: via de loop met rs.MoveNext moet de code de volgende regel pakken).
Ik ben deze week beziggeweest met het maken van een access database voor op onze afdeling. De database bestaat uit een formulier om data toe te voegen (verder niet zo heel spannend).
Mijn idee is nu om aan de hand van een knop in Access een SQL query te draaien (even simpel: SELECT * FROM Deployments ORDER BY ID DESC) en deze via een recordset overzetten naar een bestaand Word-document. Dit lukt allemaal door de tabel in mijn document te voorzien van fields.
Het probleem is nu: de recordset plaats enkel de eerste rij in mijn tabel in Word, terwijl er - momenteel - twee testrijen in de database staan.
Mijn vraag is: hoe zorg je ervoor dat je via VBA in Access een nieuwe rij aan de tabel in Word laat toevoegen wanneer er meer dan een één record opgevraagd wordt vanuit de query?
Ik heb nu dit (je zou zeggen: via de loop met rs.MoveNext moet de code de volgende regel pakken).
Code:
Private Sub reportQuery1_Click()
'Define variables
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim WordApp As Word.Application
Dim doc As Word.Document
Dim strSql As String
Dim fld1, fld2, fld3, fld4, fld5, fld6, fld7 As Field
'Avoid error and set Word object variable
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err = 429 Then
Set WordApp = New Word.Application
Err = 0
End If
'Set the database
Set dbs = CurrentDb()
strSql = "SELECT * FROM Deployments ORDER BY ID DESC"
'Set the recordset
Set rs = dbs.OpenRecordset(strSql)
Set fld1 = rs.Fields(1)
Set fld2 = rs.Fields(2)
Set fld3 = rs.Fields(3)
Set fld4 = rs.Fields(4)
Set fld5 = rs.Fields(5)
Set fld6 = rs.Fields(6)
Set fld7 = rs.Fields(7)
'Cycle through records to fill Word form fields
Do While Not rs.EOF
'Set path to document
Set doc = WordApp.Documents.Open("D:\users\mazijkde\Desktop\template.docx", , True)
'Print data to fields in Word
With doc
.FormFields("fldInsertDate").Result = fld1.Value
.FormFields("fldQaEnv").Result = fld2.Value
.FormFields("fldAdapter").Result = fld3.Value
.FormFields("fldEnvironment").Result = fld4.Value
.FormFields("fldConfiguration").Result = fld5.Value
.FormFields("fldActiveDate").Result = fld6.Value
.FormFields("fldActiveTime").Result = fld7.Value
.Visible = True
.Activate
rs.MoveNext
End With
Loop
'Unset Word application
Set doc = Nothing
Set WordApp = Nothing
Exit Sub
'Error handling
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
