Please help with MS Word automation from Access

[mr_ocp]

Hi

I have to automate a report in Word through MS Access, the report is
fairly large and some sections are to be populated from the database I
am using DAO recordset, these sections span over a few pages with data
from access into word tables, what I need to do is to print 33 rows of
recordset to a page and then go to the next page, first print the
section heading, column headings in the top row, then write another 33
rows and so on until the whole recordset has been printed.

Can some one please with necessary code changes to the following
routines

Thanks a bunch.




Public Sub CreateWordTable(rs As DAO.Recordset, strFilePathAndName As
String)
'this code will require a reference to Word
On Error GoTo ProcError
Dim WordObj As Word.Application
Dim oTable As Word.Table
Dim oRange As Word.Range
Dim fld As DAO.Field
Dim f As Integer
Dim c As Integer
Dim r As Integer

'now lets see what we get with Word
On Error Resume Next

'delete file if exists
If Dir(strFilePathAndName) <> "" Then Kill strFilePathAndName

'Attempt to reference Word which may already be running.
Set WordObj = GetObject(, "Word.Application")

If WordObj Is Nothing Then
'Word is not running, better try and start it
Set WordObj = CreateObject("Word.Application")
'Now if WordObj Is Nothing, MS Word is not installed.
If WordObj Is Nothing Then
MsgBox "MS Word is not installed on your computer"
GoTo Exit Here
End If
End If

'reset to regular error handling
On Error GoTo ProcError
With WordObj
.Visible = True
.Documents.Add
Set oRange = .ActiveDocument
Set oTable = ActiveDocument.Tables.Add(oRange, rs.RecordCount,
rs.Fields.Count)
oTable.AutoFormat Format:=wdTableFormatClassic2

Do Until rs.EOF
For c = 1 To oTable.Columns.Count
oTable.Cell(rs.AbsolutePosition, c).Select
.Selection.Text = rs(c - 1)
Next
rs.MoveNext
Loop


.ActiveDocument.SaveAs strFilePathAndName
End With

Exit Here:

WordObj.Documents.Close
WordObj.Quit


Set oTable = Nothing
Set WordObj = Nothing

Exit Sub

ProcError:
Select Case Err.Number
Case Else
MsgBox "Unanticipated error " & Err.Number & " " &
Err.Description & " Aborting!"
Stop
Resume 0 'Hit F8 to goto line with error
End Select

End Sub

 

[Peter Hewett]

Hi mr_ocp

I've hacked at your code. I have not been able to run it as I don't have the appropriate
table setup. This should get you on your way:

Public Sub CreateWordTable(ByVal rs As DAO.Recordset, _
ByVal strFilePathAndName As String)

Const RECORDS_Per_Page As Long = 33

'this code will require a reference to Word
On Error GoTo ProcError

Dim appWord As Word.Application
Dim docNew As Word.Document
Dim oTable As Word.Table
Dim oRange As Word.Range
Dim fld As DAO.Field
Dim f As Long
Dim lngColumn As Long
Dim r As Long

'now lets see what we get with Word
On Error Resume Next

'delete file if exists
If LenB(Dir$(strFilePathAndName)) > 0 Then Kill strFilePathAndName

'Attempt to reference Word which may already be running.
Set appWord = GetObject(, "Word.Application")

If appWord Is Nothing Then
'Word is not running, better try and start it
Set appWord = CreateObject("Word.Application")

'Now if appWord Is Nothing, MS Word is not installed.
If appWord Is Nothing Then
MsgBox "MS Word is not installed on your computer"
GoTo ExitHere
End If
End If

'reset to regular error handling
On Error GoTo ProcError
With appWord
.Visible = True
Set docNew = .Documents.Add
Set oRange = docNew.Content
Set oTable = oRange.Tables.Add(oRange, _
rs.RecordCount + 1, rs.Fields.Count)
oTable.AutoFormat Format:=wdTableFormatClassic2
End With

With oTable
Do Until rs.EOF

' Table must have a header row
If rs.AbsolutePosition = 1 Then
.Rows(1).HeadingFormat = CLng(True)

' Insert table header row here
End If

' Force this row to start on a new page
If rs.AbsolutePosition Mod 33 = 0 Then
.Cell(rs.AbsolutePosition, lngColumn).Range. _
Paragraphs(1).PageBreakBefore = True
End If

' Transfer record to the table
For lngColumn = 1 To oTable.Columns.Count
.Cell(rs.AbsolutePosition, lngColumn).Range.Text = rs(lngColumn - 1)
Next
rs.MoveNext
Loop
End With

docNew.SaveAs strFilePathAndName

ExitHere:
appWord.Documents.Close
appWord.Quit

Set oTable = Nothing
Set appWord = Nothing

Exit Sub

ProcError:
Select Case Err.Number
Case Else
MsgBox "Unanticipated error " & Err.Number & " " & _
Err.Description & " Aborting!"
Stop
Resume 0 'Hit F8 to goto line with error
End Select
End Sub

I've added an extra row to your table to contain the header information. I don't know
what text you require in the header row so you'll need to add this. On every 33rd record
the code sets the Paragraph formatting to be "PageBreakBefore", this causes that row to
start on a new page.

I've done away with the Selection object as the Range object is more efficient.

Depending on the version of Office you intend to use you may wish to consider dumping the
DAO code for ADO. DAO is only there for compatibility.

HTH + Cheers - Peter


(e-mail address removed) (mr_ocp), said:

 

[mr_ocp]

Great thanks Peter
I will work on your solution in a couple of days, as I said the report
I am working on is fairly large and without understanding the full
object model of the word things wont be easier for me, is there a
tutorial around that list all the objects in the word model.

Your code has given me a clue on how to achive a page break, but there
are many more things that I would need to know such as :

1) How do I know how many lines are available on a new page

2) how to keep track of what line I have last written on a page

3) How to go to a certain line on the page and write somethng

4) how to go to a certain page

etc etc ....

If there is good book that may help me, please let me know

Thanks again for all your help

 

[Peter Hewett]

Hi mr_ocp

Answered inline.

(e-mail address removed) (mr_ocp), said:

Great thanks Peter
I will work on your solution in a couple of days, as I said the report
I am working on is fairly large and without understanding the full
object model of the word things wont be easier for me, is there a
tutorial around that list all the objects in the word model.

Your code has given me a clue on how to achive a page break, but there
are many more things that I would need to know such as :

1) How do I know how many lines are available on a new page

This is a lot more difficult than you might think. It depends upon the largest font size
used by a character, space before/after. Word is not line or page oriented! Word
revolves around paragraphs. A paragraph can contain any number of lines.

2) how to keep track of what line I have last written on a page

Use a range object to keep track of where you are.

3) How to go to a certain line on the page and write somethng

Use a bookmark.

4) how to go to a certain page

You can go to a particular page but if you use bookmarks your focus on pages may diminish.
Word has collection objects for Sections, Paragraphs, Words, Characters, but *not* for
Lines and Pages. The reason for this is that a line in a particular document can never be
guaranteed to contain the same text on two different PC's. Likewise the same is true for
a page in a particular document. It can never be guaranteed to contain the same text on
two different PC's This is because the page layout is governed by the selected printer.

If you must goto a particular page you can use:
Dim rngPage As Word.Range
Set rngPage = ActiveDocument.Content.GoTo(wdGoToPage, wdGoToAbsolute, 2)

the range object will be set to the begriming of the specified page.

etc etc ....

If there is good book that may help me, please let me know

I've not come across a book specifically on Word VBA that I'd recommend, however
my favorite VBA book is:

Visual Basic Language Developers Handbook
Ken Getz/Mike Gilbert
Sybex
ISBN: 0-8721-2162-4

This was published a couple of years back but may still be in print, if not it's
worth trying to get a "pre-owned" version through Amazon etc.

On the Word front I'd recommend:

1. Make sure you have the Word VBA online help installed, if not - Do it now!
2. Make use of and familiarise yourself with the VBA IDEs Object Browser (F2)
3. Use the MVP website: http://word.mvps.org/index.html
4. Use the Google News Group search feature

Thanks again for all your help

Good luck + Cheers - Peter
HTH + Cheers - Peter

 

[mr_ocp]

Thanks Peter your quick answers are appreciated.
Here's another question for you, while working on a document is it
possible to copy contents ( contents will consist of formatted text,
tables and bookmarks) from another template and paste them on the
working document if so can you please give me a code example of how.
Thanks much
Terry

 

[Peter Hewett]

Hi mr_ocp

The following code is an example of how you can move text between two documents without
using the clipboard (copy/paste). It uses both Range and Document objects:

Public Sub CopyFormattedText()
Dim docSource As Word.Document
Dim docDestination As Word.Document
Dim rngSource As Word.Range
Dim rngDestination As Word.Range
Dim lngIndex As Long

Set docSource = Documents.Open("c:\test\source.doc")
Set docDestination = Documents.Add("c\test\dest.dot")

' Add output to the end of the document
Set rngDestination = docDestination.Content
rngDestination.Collapse wdCollapseEnd

' Copy odd section numbers to the new document
With docSource
For lngIndex = 1 To .Sections.Count
If lngIndex Mod 2 = 1 Then
Set rngSource = .Sections(lngIndex).Range

' Copy text to new document
rngDestination.FormattedText = rngSource.FormattedText
rngDestination.Collapse wdCollapseEnd
End If
Next
End With
End Sub

If you have any follow up question that are not directly related to this thread please
start another thread. I am heavily committed to a project for one of my clients and I
can't guarantee to get back to you.

HTH + Cheers - Peter


(e-mail address removed) (mr_ocp), said:

 

[mr_ocp]

If you have any follow up question that are not directly related to this thread please
start another thread. I am heavily committed to a project for one of my clients and I
can't guarantee to get back to you.

Thanks buddy, I understand I will do as you suggested.
Terry