Manipulating MS Word programmatically using MS Access 2003

[Lightwave]

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.

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

 

[Lightwave]

UPDATE : Took out

Exit Function

From part of the code as the function was being needlessly exited IF a parent did not contain any child records. The Exit Function was at the end of the nested loop in the child records.

This still remains within the code of the example database but won't show up as all parent records have child records. Just be aware of this if you are transferring code to other projects.