Ms-Access form data export to Word - vba

Question

I really some help! Here's a link to a google drive zip of the access database that I'm struggling with.
https://drive.google.com/file/d/0BwjnhQS2X7_Qamt4clFLc1Ztb2c/view?usp=sharing
So, what I have is an access database made up of a few tables and a form and some sub forms. The database info gets inputted to the tables via a form that I've created. In the example, the form is called "Database". This form exports to a word document, fields on the database go to bookmarks on the word doc. This works great so far.
In the attachment there is a "template" folder with the original word document, when the code runs it saves the completed form to the "generated" folder - works like a charm. Its a very long form for applications for liquor licenses.
So you fill in the form in access, it saves to the tables and exports the data to the word template document.
The problem that I have is that there is a subform on tab8 of the form where "director details" are saved. There can be any number of directors per application. I've managed to access the data on the subform's table, but have no idea how to loop through the data in that table to get all the information that is applicable to that application only and not data related to other applications. There is a relationship between the director details table and the application details table(this is the main table) and I'm using an application identifier field that I've created called and "ACNumber" which is unique to each application. There is a combobox on the form that selects the application and the form and subforms bring up the correct data when you select it.
The other part of the problem is how do I output this to word? A bookmark won't work, because all the fields are being repeated. Is there a way that all the data entries can be outputted to a single bookmark mabe in a textbox with the labels?
This is how it looks on the word document form:
(First person)
Full name : generate from item 5.4(a) from database
Physical address : generate from item 5.4(b) from database
Postal code : generate from item 5.4(c) from database
Postal address : generate from item 5.4(d) from database
Postal code : generate from item 5.4(e) from database
Identity number : generate from item 5.4(f) from database
(More person’s to add if needed)
Ok, I hope that describes my problem accurately.
I've tried all sorts to get this working, but its beyond me, please help guys!!!
Below is the code that I'm using: (the loop for the subform doesn't work, but one entry from that table is exported to the bookmarks currently in place)
I've tried all sorts to get this working, but its beyond me, please help guys!!!
`Private Sub ExportToWord_Click()
'Print customer slip for current customer.
Dim appWord As Word.Application
Dim doc As Word.Document
Dim drst As Recordset
Set drst = CurrentDb.OpenRecordset(Name:="62 Other Interests", Type:=RecordsetTypeEnum.dbOpenDynaset)
'Avoid error 429, when Word isnt open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isnt open, create a new instance of Word.
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Open("C:\forms\templates\Form 3 - Sec 36(1).docx", , True)
With doc
.Bookmarks("wAppTradingNames").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wCompanyName").Range.Text = Nz(Me!CompanyName, "")
.Bookmarks("wCompanyNumber").Range.Text = Nz(Me!CompanyNumber, "")
.Bookmarks("wRAddress1").Range.Text = Nz(Me!RAddress1, "")
.Bookmarks("wPostalCode").Range.Text = Nz(Me!PostalCode, "")
.Bookmarks("wRPostalAddress1").Range.Text = Nz(Me!RPostalAddress1, "")
.Bookmarks("wRPostalCode").Range.Text = Nz(Me!RPostalCode, "")
.Bookmarks("wDomicilium1").Range.Text = Nz(Me!Domicilium1, "")
.Bookmarks("wDomiciliumCode").Range.Text = Nz(Me!DomiciliumCode, "")
.Bookmarks("wDomAfter1").Range.Text = Nz(Me!DomAfter1, "")
.Bookmarks("wDomAfterCode").Range.Text = Nz(Me!DomAfterCode, "")
.Bookmarks("wTelOffice").Range.Text = Nz(Me!TelOffice, "")
.Bookmarks("wTelCell").Range.Text = Nz(Me!TelCell, "")
.Bookmarks("wTelHome").Range.Text = Nz(Me!TelHome, "")
.Bookmarks("wFaxNumber").Range.Text = Nz(Me!FaxNumber, "")
.Bookmarks("wEmail").Range.Text = Nz(Me!Email, "")
.Bookmarks("wFIP").Range.Text = Nz(Me!FIP, "")
.Bookmarks("wAppLicCat").Range.Text = Nz(Me!AppLicCat, "")
.Bookmarks("wLiqourType").Range.Text = Nz(Me!LiqourType, "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wLPAddress").Range.Text = Nz(Me!LPAddress, "")
.Bookmarks("wErfNumber").Range.Text = Nz(Me!ErfNumber, "")
.Bookmarks("wLPPostalCode").Range.Text = Nz(Me!LPPostalCode, "")
.Bookmarks("wLPOwnership").Range.Text = Nz(Me!LPOwnership, "")
.Bookmarks("wLPOwnersName").Range.Text = Nz(Me!LpOwnersName, "")
.Bookmarks("wLpOwnerAddress").Range.Text = Nz(Me!LpOwnerAddress, "")
.Bookmarks("wLpRightOccupation").Range.Text = Nz(Me!LpRightOccupation, "")
.Bookmarks("wLPOccDuration").Range.Text = Nz(Me!LPOccDuration, "")
.Bookmarks("wLpPremNotErected").Range.Text = Nz(Me!LpPremNotErected, "")
.Bookmarks("wLpPremAlterReq").Range.Text = Nz(Me!LpPremAlterReq, "")
.Bookmarks("wLpPremAllGood").Range.Text = Nz(Me!LpPremAllGood, "")
.Bookmarks("wLpBuildCommence").Range.Text = Nz(Me!LpBuildCommence, "")
.Bookmarks("wLpBuildDuration").Range.Text = Nz(Me!LpBuildDuration, "")
.Bookmarks("wLpTradingHours").Range.Text = Nz(Me!LpTradingHours, "")
.Bookmarks("wLpRenewal").Range.Text = Nz(Me!LpRenewal, "")
.Bookmarks("wLpJobsa").Range.Text = Nz(Me!LpJobsa, "")
.Bookmarks("wLpJobsB").Range.Text = Nz(Me!LpJobsB, "")
.Bookmarks("wLpJobsC").Range.Text = Nz(Me!LpJobsC, "")
.Bookmarks("wNNPRegName").Range.Text = Nz(Me!NNPRegName, "")
.Bookmarks("wNNPRegNumber").Range.Text = Nz(Me!NNPRegNumber, "")
.Bookmarks("wNNPRegDate").Range.Text = Nz(Me!NNPRegDate, "")
.Bookmarks("wOtherInterests").Range.Text = Nz(drst!OtherInterests, "")
.Visible = True
.Activate
End With
Dim rst As Recordset: Set rst = CurrentDb.OpenRecordset(Name:="5 Director Details", Type:=RecordsetTypeEnum.dbOpenDynaset)
'Do While Not rst.EOF
With doc
.Bookmarks("wPersonLabel").Range.Text = Nz(rst!PersonLabel, "")
.Bookmarks("wFullName").Range.Text = Nz(rst!FullName, "")
.Bookmarks("wPhAddress").Range.Text = Nz(rst!PhAddress, "")
.Bookmarks("wPhCode").Range.Text = Nz(rst!PhCode, "")
.Bookmarks("wPAddress").Range.Text = Nz(rst!PAddress, "")
.Bookmarks("wPCode").Range.Text = Nz(rst!PCode, "")
.Bookmarks("wIdNumber").Range.Text = Nz(rst!IdNumber, "")
.Visible = True
.Activate
rst.MoveNext
End With
'Loop
doc.SaveAs2 "C:\forms\generated\" & Me!ACNumber & "_Form 3 - Sec 36(1).docx"
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
`

Answer 1

This will point you to the right direction. You need to make a couple of changes though to fit your needs e.g. insert all your bookmarks, update the SQL strings and recordset fields.
You also need to make a few changes to your Word document though:
1) Add a table to hold the manager data (loop). Hide the borders if needed.
2) Save the document as Word Template (.dotx)
Public Sub ExportToWord()
On Error GoTo ErrorTrap
Const TemplatePath As String = "C:\forms\templates\Form 3 - Sec 36(1).dotx"
'Data
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)
'SaveAs
Dim name_ As String
name_ = "C:\forms\generated\" & rs![FieldName] & "_Form 3 - Sec 36(1).docx"
'Word
Dim oWord As Word.Application
Set oWord = New Word.Application
oWord.Visible = False
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Add(TemplatePath)
With oDoc
.Bookmarks("Bookmark_1").Range.Text = rs![FieldName_1]
.Bookmarks("Bookmark_2").Range.Text = rs![FieldName_2]
.Bookmarks("Bookmark_3").Range.Text = rs![FieldName_3]
'...
End With
rs.Close
Set rs = Nothing
'Loop data
Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)
With rs
If Not .EOF Then
.MoveLast
.MoveFirst
End If
End With
Dim idx As Integer
For idx = 1 To rs.RecordCount
With oDoc.Tables(1)
.Cell(idx, 1).Range.Text = rs![FieldName_1] '1st Column
.Cell(idx, 2).Range.Text = rs![FieldName_2] '2nd Column
.Cell(idx, 3).Range.Text = rs![FieldName_1] '3rd Column
'...
'add extra rows if required
If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
End With
rs.MoveNext
Next idx
'Save
With oDoc
.SaveAs FileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
.Close SaveChanges:=wdDoNotSaveChanges
End With
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
oWord.Quit
Set oWord = Nothing
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical, "ExportToWord()"
Resume Leave
End Sub