Losing last line of recordset

[RedHeadedMonster]

I've created a form that transfers a report into a Word Document
Table. Program working well, except that for whatever reason, the
last line of data in the record set is not showing up in the table.
Below is the code, what am I missing? Why am I losing the last line
of data?

Thanx!
RHM

Private Sub cmdCreateCDRLReport_Click()

Dim aWordApp As Word.Application
Dim aRange As Word.Range, aTable As Word.Table
Dim aCell As Word.Cell
Dim iCol As Integer, iRow As Integer


'define recordset
Dim rst1 As DAO.Recordset
Set rst1 = Me.ss_Weekly_MAIN.Form.Recordset

'create word document
Set aWordApp = CreateObject("Word.Application")
aWordApp.Documents.Add

'insert title & date range

With aWordApp.ActiveDocument.Paragraphs(1).Range
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Bold = True
.Font.Name = "Time New Roman"
.Font.Size = 10
.Text = "CDRL Status" & vbCr & Me.TimePeriod & vbCr
End With

'create table
Set aRange = aWordApp.ActiveDocument.Range
aRange.Collapse wdCollapseEnd

aWordApp.ActiveDocument.Tables.Add Range:=aRange,
NumRows:=rst1.RecordCount + 2, NumColumns:=8

'Make word visible
aWordApp.Visible = True

'format table and data


With aWordApp.ActiveDocument.Tables(1)
.AutoFormat wdTableFormatClassic2
.AutoFitBehavior wdAutoFitContent
'Paragraph alignment
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Font.Name = "Time New Roman"
.Range.Font.Size = 10

With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = wdColorBlack
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = wdColorBlack
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = wdColorBlack
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False



End With

'insert and format column titles
With aWordApp.ActiveDocument.Tables(1).Rows(1)

With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorLightGreen
End With

.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth150pt
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineWidth = wdLineWidth150pt


.Borders(wdBorderBottom).Visible = True
.Cells(1).Range.Text = "Project"
.Cells(1).Range.Font.Color = wdColorBlack
.Cells(2).Range.Text = "# CDRLs Submitted On-Time"
.Cells(2).Range.Font.Color = wdColorBlack
.Cells(3).Range.Text = "# CDRLs Submitted Late"
.Cells(3).Range.Font.Color = wdColorBlack
.Cells(4).Range.Text = "# CDRLs Approved"
.Cells(4).Range.Font.Color = wdColorBlack
.Cells(5).Range.Text = "# CDRLs Approved w/ Changes"
.Cells(5).Range.Font.Color = wdColorBlack
.Cells(6).Range.Text = "# CDRLs Closed"
.Cells(6).Range.Font.Color = wdColorBlack
.Cells(7).Range.Text = "# CDRLs Disapproved"
.Cells(7).Range.Font.Color = wdColorBlack
.Cells(8).Range.Text = "# CDRLs Awaiting Approval"
.Cells(8).Range.Font.Color = wdColorBlack



End With

'insert data
For iRow = 2 To rst1.RecordCount
iCol = 0
For Each aCell In aWordApp.ActiveDocument.Tables(1).Rows
(iRow).Cells
aCell.Range.Text = IIf(rst1.Fields(iCol) > 0, rst1.Fields
(iCol), "")
iCol = iCol + 1
Next aCell
rst1.MoveNext
Next iRow

'set up last row of table as a totals column
With aWordApp.ActiveDocument.Tables(1).Rows(rst1.RecordCount + 2)
.Cells(1).Range.Text = "TOTALS"
.Cells(1).Range.Font.Bold = True
.Cells(2).Range.Text = Me.ss_Weekly_MAIN.Form.Early
.Cells(2).Range.Font.Bold = True
.Cells(3).Range.Text = Me.ss_Weekly_MAIN.Form.Late
.Cells(3).Range.Font.Bold = True
.Cells(4).Range.Text = Me.ss_Weekly_MAIN.Form.Approved
.Cells(4).Range.Font.Bold = True
.Cells(5).Range.Text = Me.ss_Weekly_MAIN.Form.ApprovedC
.Cells(5).Range.Font.Bold = True
.Cells(6).Range.Text = Me.ss_Weekly_MAIN.Form.Closed
.Cells(6).Range.Font.Bold = True
.Cells(7).Range.Text = Me.ss_Weekly_MAIN.Form.Disapproved
.Cells(7).Range.Font.Bold = True
.Cells(8).Range.Text = Me.ss_Weekly_MAIN.Form.Await
.Cells(8).Range.Font.Bold = True

With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorLightGreen
End With

.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth150pt
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineWidth = wdLineWidth150pt

End With

With aWordApp.ActiveDocument.Tables(1)
.AutoFitBehavior wdAutoFitFixed
End With

End Sub

 

[Tony Jollans]

My first guess would be the line:

For iRow = 2 To rst1.RecordCount

which will loop one time fewer than the number of records in the recordset.

 

[RedHeadedMonster]

Thanx! Got it working now.

RHM