Lightwave
Ad astra
- Local time
- Today, 20:49
- Joined
- Sep 27, 2004
- Messages
- 1,537
The following code and example database takes two tables T001ParentRecords and T002ChildRecords and creates separate word documents for each parent record. A new word doc is created for each parent record and then three fields for each child that relate to the parent are placed in the document. Lastly the word document is formatted before being saved.
The important function is here
To run the code open the second module within the database window so that you have the visual basic editor up. Then within the immediate window type
?AutoGenerateParentChildWordDocuments
When you press return multiple documents should be created and placed in the c:\temp directory. Alter this directory to place the generated files elsewhere.
The important function is here
To run the code open the second module within the database window so that you have the visual basic editor up. Then within the immediate window type
?AutoGenerateParentChildWordDocuments
When you press return multiple documents should be created and placed in the c:\temp directory. Alter this directory to place the generated files elsewhere.
Code:
Function AutoGenerateParentChildWordDocuments()
'Make sure the name of the recordset is unambigous
'Good practice to reference the actual library
'Please ensure that you go to Tools - Refererences and select Microsoft Word 11 0 Object Library
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim rschild As DAO.Recordset
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set db = CurrentDb
'Place your SQL for parent records to be created
Set rs = db.OpenRecordset("SELECT * FROM T001ParentRecords")
If Not (rs.EOF And rs.BOF) Then
'There are no records if EOF and BOF are both true you are at the end and at the beginning
rs.MoveLast
rs.MoveFirst
While (Not rs.EOF)
Set wrdApp = CreateObject("Word.Application")
'Create the new document
Set wrdDoc = wrdApp.Documents.Add
'The following line can be altered to open the document on the screen
wrdApp.Visible = False
'Next setup the margins of the document
'This is setup for narrow margins
wrdDoc.PageSetup.LeftMargin = CentimetersToPoints(1.27)
wrdDoc.PageSetup.RightMargin = CentimetersToPoints(1.27)
wrdDoc.PageSetup.TopMargin = CentimetersToPoints(1.27)
wrdDoc.PageSetup.BottomMargin = CentimetersToPoints(1.27)
With wrdDoc
.Styles(wdStyleHeading1).Font.Name = "Algerian"
.Styles(wdStyleHeading1).Font.Size = 14
.Styles(wdStyleHeading1).Font.Bold = True
.Styles(wdStyleHeading1).Font.Color = wdColorBlack
.Styles(wdStyleHeading3).Font.Name = "Courier"
.Styles(wdStyleHeading3).Font.Size = 12
.Styles(wdStyleHeading3).Font.Bold = False
.Styles(wdStyleHeading3).Font.Color = wdColorBlack
.Styles(wdStyleHeading3).NoSpaceBetweenParagraphsOfSameStyle = True
.Styles(wdStyleHeading3).ParagraphFormat.Alignment = wdAlignParagraphJustify
.Styles(wdStyleHeading2).Font.Name = "Arial"
.Styles(wdStyleHeading2).Font.Size = 12
.Styles(wdStyleHeading2).Font.Bold = True
.Styles(wdStyleHeading2).Font.Color = wdColorRed
.Styles(wdStyleHeading2).NoSpaceBetweenParagraphsOfSameStyle = True
.Styles(wdStyleHeading2).ParagraphFormat.Alignment = wdAlignParagraphJustify
.Styles(wdStyleNormal).Font.Name = "Arial"
.Styles(wdStyleNormal).Font.Size = 10
.Styles(wdStyleNormal).Font.Color = wdColorBlue
'Better to set style before insert
.Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading1)
.Content.InsertAfter ("Sitename:" & rs!Sitename)
.Content.InsertParagraphAfter
.Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading3)
.Content.InsertAfter ("Town:" & rs!Town)
.Content.InsertParagraphAfter
.Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading3)
.Content.InsertAfter ("Postcode:" & rs!Postcode)
.Content.InsertParagraphAfter
Set rschild = db.OpenRecordset("SELECT * FROM T002ChildRecords WHERE FKID = " & rs!PKID)
If Not (rschild.EOF And rschild.BOF) Then
'There are no records if EOF and BOF are both true you are at the end and at the beginning
rschild.MoveLast
rschild.MoveFirst
While (Not rschild.EOF)
'Again better to set style before insert
.Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading1)
.Content.InsertAfter ("Consulting Body:" & rschild!Body)
.Content.InsertParagraphAfter
.Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading2)
.Content.InsertAfter ("Consultation response : " & rschild!Comment)
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleNormal)
.Content.InsertAfter ("Consultation Date: " & rschild!DateUpdated)
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
rschild.MoveNext
Wend
Else
End If
rschild.Close
.SaveAs ("c:\temp\Auto-Generated-WordDoc-" & rs!Town & rs!PKID & ".doc")
.Close ' close the document
End With ' With wrdDoc
Set wrdDoc = Nothing
wrdApp.Quit ' close the Word application
Set wrdApp = Nothing
rs.Edit
rs.Update
rs.MoveNext
Wend
rs.Close
Else
MsgBox "No Records Available for updating exit sub"
Exit Function
End If
MsgBox "Looped through the records and updated the value number field"
Set rschild = Nothing
Set rs = Nothing
Set db = Nothing
End Function
Last edited:
