Document Range Method - Word Object Model (1 Viewer)

Lightwave

Ad astra
Local time
Today, 23:27
Joined
Sep 27, 2004
Messages
1,441
Issue with appropriate formating when creating Word Documents from an Access 2003 function that creates docs.

I have written a function within Access 2003 to try and create a word doc in word 2010.

I create a recordset from a parent table and then create a further recordset of the children of this parent table. I then create a word document for each parent and place the children records within the document.

The children vary in number for each parent and I place loop through the related child records placing 3 fields for each child into the parents word document. I would like to format these children fields appropriately. Code listed below

Unfortunately - the formatting is only registering against the final child record to be added to the document and not all of the other ones. I've been hacking about with it but can't seem to get it working. It would appear to be something to do with the syntax of my range property.

Has anyone got any ideas where I am going wrong?

I will try and add the mdb

Code:
Function ParentandChildintoSeparateWordDocs()

'Make sure the name of the recordset is unambigous
'Good practice to reference the actual library

Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim dbChild As DAO.Database
Dim rschild As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM T045ExpressionInterest where Extra = 555")

With rs

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

Do Until rs.EOF = True

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add ' create a new document
wrdApp.Visible = True
'this line can be altered to open the document on the screen

With wrdDoc

.Content.InsertAfter ("Proposer:" & rs!Proposer)
.Content.InsertParagraphAfter

.Content.InsertAfter ("Summary of the Submission:" & rs!SummarySubmission)
.Content.InsertParagraphAfter

.Content.InsertAfter ("Synoptic Conclusion:" & rs!ConclusionSynopsis)
.Content.InsertParagraphAfter

        Set dbChild = CurrentDb
        Set rschild = db.OpenRecordset("SELECT * FROM T046EOIComments WHERE FKID = " & rs!PKID)

        With rschild

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

Do Until rschild.EOF = True

With wrdDoc

        .Styles(wdStyleHeading1).Font.Name = "Times New Roman"
        .Styles(wdStyleHeading1).Font.Size = 16
        .Styles(wdStyleHeading1).Font.Bold = True
        .Styles(wdStyleHeading1).Font.Color = wdColorBlack
        
        .Styles(wdStyleHeading2).Font.Name = "Stencil"
        .Styles(wdStyleHeading2).Font.Size = 12
        .Styles(wdStyleHeading2).Font.Bold = True
        .Styles(wdStyleHeading2).Font.Color = wdColorRed
        
        .Styles(wdStyleNormal).Font.Name = "Arial"
        .Styles(wdStyleNormal).Font.Size = 10
        .Styles(wdStyleNormal).Font.Color = wdColorBlue

.Content.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
.Content.ParagraphFormat.LineSpacing = 5

.Range(0).Style = .Styles(wdStyleHeading1)
.Content.InsertAfter ("Consulting Body:" & rschild!Body)
.Content.InsertParagraphAfter

.Range(.Characters.Count - 1).Style = .Styles(wdStyleHeading2)
.Content.InsertAfter ("Consultation response : " & rschild!Comment)
.Content.InsertParagraphAfter

.Range(.Characters.Count - 1).Style = .Styles(wdStyleNormal)
.Content.InsertAfter ("Date Updated: " & rschild!DateUpdated)
.Content.InsertAfter (" ")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter



End With

rschild.MoveNext
Loop
Else
Exit Function
End If

rschild.Close
End With
Set rschild = Nothing
Set dbChild = Nothing


.SaveAs ("\\directory\CreatedWordDoc" & rs!EOINumber & ".doc")
.Close ' close the document
End With ' With wrdDoc

wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing

rs.Edit
rs!Extra = 555
rs.Update
rs.MoveNext
Loop
Else
MsgBox "No Records Available for updating exit sub"
Exit Function
End If
MsgBox "Looped through the records and updated the value number field"
rs.Close
End With
Set rs = Nothing
Set db = Nothing


End Function
 

GohDiamond

"Access- Imagineer that!"
Local time
Today, 18:27
Joined
Nov 1, 2006
Messages
549
Get rid of Do Until ... loop

With recordsets you want to use While ... WEND

Code:
While NOT rschild.EOF 

[INDENT]With...
End With[/INDENT]


rschild.movenext

WEND

rschild.close

Try applying this to your code and see if it helps.

Cheers!
Goh
 

sneuberg

AWF VIP
Local time
Today, 16:27
Joined
Oct 17, 2014
Messages
3,506
If you give the range a definite start and end as I try in the hack below it gets closer to what you want but screws up the spacing in other ways.


Code:
[COLOR="DarkRed"]Dim CharCount As Long[/COLOR]
.Content.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
.Content.ParagraphFormat.LineSpacing = 5
[COLOR="darkred"]CharCount = .Characters.Count[/COLOR]
'.Range(0).Style = .Styles(wdStyleHeading1)
.Content.InsertAfter ("Consulting Body:" & rschild!Body)
.Content.InsertParagraphAfter
[COLOR="darkred"].Range(CharCount, .Characters.Count - 1).Style = .Styles(wdStyleHeading1)[/COLOR]

'.Range(.Characters.Count - 1).Style = .Styles(wdStyleHeading2)
[COLOR="darkred"]CharCount = .Characters.Count[/COLOR]
.Content.InsertAfter ("Consultation response : " & rschild!Comment)
.Content.InsertParagraphAfter
[COLOR="darkred"].Range(CharCount, .Characters.Count - 1).Style = .Styles(wdStyleHeading2)[/COLOR]

' .Range(.Characters.Count - 1).Style = .Styles(wdStyleNormal)
[COLOR="darkred"]CharCount = .Characters.Count[/COLOR]
.Content.InsertAfter ("Date Updated: " & rschild!DateUpdated)
.Content.InsertAfter (" ")
.[COLOR="darkred"]Range(CharCount, .Characters.Count - 1).Style = .Styles(wdStyleNormal)[/COLOR]
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter

Sorry but I ran out of time to play with this. Hope this helps somehow.
 

stopher

AWF VIP
Local time
Today, 23:27
Joined
Feb 1, 2006
Messages
2,396
.range in your code is referring to everything in your doc i think: (wrdDoc.range)

So each time you loop you are applying wdStyleHeading1 to everything then applying wdStyleHeading2 to the last bit.

I think you should apply you formatting to the current selection as you go or maybe use .paragraph.range

hth
 

stopher

AWF VIP
Local time
Today, 23:27
Joined
Feb 1, 2006
Messages
2,396
Try this:

Code:
Function ParentandChildintoSeparateWordDocs()

'Make sure the name of the recordset is unambigous
'Good practice to reference the actual 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
Set rs = db.OpenRecordset("SELECT * FROM T045ExpressionInterest where Extra = 555")

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.MoveFirst
    Do Until rs.EOF = True
        Set wrdApp = CreateObject("Word.Application")
        
        Set wrdDoc = wrdApp.Documents.Add ' create a new document
        wrdApp.Visible = True
        'this line can be altered to open the document on the screen
        
        With wrdDoc
        
            .Styles(wdStyleHeading1).Font.Name = "Times New Roman"
            .Styles(wdStyleHeading1).Font.Size = 16
            .Styles(wdStyleHeading1).Font.Bold = True
            .Styles(wdStyleHeading1).Font.Color = wdColorBlack
            
            .Styles(wdStyleHeading2).Font.Name = "Stencil"
            .Styles(wdStyleHeading2).Font.Size = 12
            .Styles(wdStyleHeading2).Font.Bold = True
            .Styles(wdStyleHeading2).Font.Color = wdColorRed
            
            .Styles(wdStyleNormal).Font.Name = "Arial"
            .Styles(wdStyleNormal).Font.Size = 10
            .Styles(wdStyleNormal).Font.Color = wdColorBlue
        
        
            .Content.InsertAfter ("Proposer:" & rs!Proposer)
            .Content.InsertParagraphAfter
            
            .Content.InsertAfter ("Summary of the Submission:" & rs!SummarySubmission)
            .Content.InsertParagraphAfter
            
            .Content.InsertAfter ("Synoptic Conclusion:" & rs!ConclusionSynopsis)
            .Content.InsertParagraphAfter
            
            Set rschild = db.OpenRecordset("SELECT * FROM T046EOIComments 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.MoveFirst
    
                Do Until rschild.EOF = True
                    
                    .Content.InsertAfter ("Consulting Body:" & rschild!Body)
                    .Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading1)
                    
                    .Content.InsertParagraphAfter
                    .Content.InsertAfter ("Consultation response : " & rschild!Comment)
                    .Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleHeading2)
                    
                    .Content.InsertParagraphAfter
                    .Content.InsertAfter ("Date Updated: " & rschild!DateUpdated)
                    .Paragraphs(.Paragraphs.Count).Style = .Styles(wdStyleNormal)
                    
                    .Content.InsertAfter (" ")
                    .Content.InsertParagraphAfter
                    .Content.InsertParagraphAfter
        
                    rschild.MoveNext
                Loop
            Else
                Exit Function
            End If
    
            rschild.Close
            
            .SaveAs ("C:\temp\CreatedWordDoc" & rs!EOINumber & ".doc")
            .Close ' close the document
        End With ' With wrdDoc
        Set wrdDoc = Nothing
        
        wrdApp.Quit ' close the Word application
        Set wrdApp = Nothing
        
        rs.Edit
        rs!Extra = 555
        rs.Update
        rs.MoveNext
    Loop
    
    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

Ad astra
Local time
Today, 23:27
Joined
Sep 27, 2004
Messages
1,441
All - blown away by your help really very useful.

The issue was lying with the range statement as per stopher - taking out the range method using his code allowed the code to work through each paragraph as it was added rather than re selecting it each time and then just formatting the last three paragraphs.

It should be noted that I did alter the code to use the WEND statement which maintained the functionality but made no difference to the formatting issue. Many thanks everyone.
 

Lightwave

Ad astra
Local time
Today, 23:27
Joined
Sep 27, 2004
Messages
1,441
This is the code I finally settled on - The following adds formatting in terms of margin and justifying some of the paragraphs. I've also made the names of the table more generic.

This statement uses the WEND method

An example database with information and code in Access 2003 is available by following this link (see bottom)

Sample Database Link

In the meantime the code :

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 SQL here
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
 
Last edited:

Users who are viewing this thread

Top Bottom