Month: July 2016

The following code generates separate word documents for each parent record in a table called T001ParentRecords and places the children records relating to the parent record in a word document. It then goes on to format that word document before saving and closing and then moving to the next document and starting the process again.

As such it takes the code relating to looping through recordsets and also the code relating to generating word documents and combines the two. This could be very good for automatically generating whole host of different things.

It uses the WEND statement rather than the Do Until Loop as I was told it was better practice.

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
        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

Download an example database HERE

Boilerplate code demonstrating simple Recordset manipulation