I am making great strides on dumping my Cultural Directory information from Access into Word and actually have something that works. Given my complete lack of knowledge of the Word Object language, this is a start. The attached code (adapted from my email dump (which now works perfectly) and other code from one of my reference books, puts the info into a Word Document. Unfortunately it puts every name in the name field, every address in the address field, etc, so while pleased at my achievement, the data is useless
. I suspect one of two problems: I am not looping properly or I should be using merge fields rather than bookmarks in Word. In either case, this is as far as I can go on my own. Any help is greatly appreciated.
Peter N
Option Compare Database
Option Explicit
Private Const m_strDIR As String = “C:My DocumentsDataDump”
Private Const m_strTEMPLATE As String = “DirectoryOutput.dot”
Private m_objWord As Word.Application
Private m_objDoc As Word.Document
Private Sub InsertTextAtBookMark(strBkmk As String, varText As Variant)
‘ selects the bookmark and inserts the text
m_objDoc.Bookmarks(strBkmk).Select
m_objWord.Selection.Text = varText & “”
End Sub
Public Sub DataDump()
Dim db As Database ‘ current database
Dim recListMain As Recordset ‘ recordset of listings
Dim recClient As Recordset ‘ recordset of clients (for email address)
Dim strSQL As String ‘ sql string
Dim strListing As String ‘ string of listing info
Dim strCat As String ‘ just the categories items
Dim recListDetails As Recordset ‘recordset of listing details
Dim strCatDetails As Variant ‘listing details as variant
Dim strSQLDetail As String ‘sql string of listing details
‘ open the database and recordset of suppliers
Set db = CurrentDb()
Set recClient = db.OpenRecordset(“New Directory Listings”)
‘ instantiate the word application and create a new
‘ document based upon the supplied template
Set m_objWord = New Word.Application
Set m_objDoc = m_objWord.Documents.Add(m_strDIR & m_strTEMPLATE)
‘ now loop through the suppliers
While Not recClient.EOF
‘ open a recordset of the reorderable items
strSQL = “SELECT * FROM NewDirListMain WHERE ClientID = ” & recClient(“ClientID”)
Set recListMain = db.OpenRecordset(strSQL)
‘ create a string containing the order details
strCat = “”
While Not recListMain.EOF
strCat = strCat & vbCrLf & recListMain(“Directory Category”) & ” ~ ”
strSQLDetail = “SELECT * from qryNewDirectoryListingDetails WHERE ListingID = ” & recListMain(“ListingID”)
Set recListDetails = db.OpenRecordset(strSQLDetail)
strCatDetails = Null
While Not recListDetails.EOF
strCatDetails = (strCatDetails + “, “) & recListDetails(“NewDirectorySpecialties”)
recListDetails.MoveNext
Wend
recListDetails.Close
strCat = strCat & strCatDetails
recListMain.MoveNext
Wend
InsertTextAtBookMark “Name”, recClient(“FullName”)
InsertTextAtBookMark “Address1”, recClient(“Address1”)
InsertTextAtBookMark “Address2”, recClient(“Address2”)
InsertTextAtBookMark “City”, recClient(“City”)
InsertTextAtBookMark “WorkPhone”, recClient(“WorkPhone”)
InsertTextAtBookMark “Email”, recClient(“Email”)
InsertTextAtBookMark “ListDetails”, strCat
InsertTextAtBookMark “Statement”, recClient(“additionalDirectoryInfo”)
recListMain.Close
‘ move onto the next supplier
recClient.MoveNext
Wend
m_objDoc.SaveAs FileName:=m_strDIR & “DataDump” & _
” – ” & FormatDateTime(Date, vbLongDate) & “.DOC”
m_objDoc.Close
m_objWord.Quit
‘ clean up
Set m_objDoc = Nothing
Set m_objWord = Nothing
recClient.Close
Set recClient = Nothing
Set recListMain = Nothing
End Sub