Recordset Loop outputs only the last record. (1 Viewer)

[jamie_b]

Hi,

In my Word docx file is an existing table, formatted with a header row.

The code below works correctly (to a point) by transferring the recordset to the already opened docx and populating the the table with the SQL from vba, starting in the 2nd row onwards.

No errors are shown, but the problem is that only the last record of the SQL is send to the Word docx table.

I'm guessing it's something elementary that I'm missing. Please help if you can.

On Error GoTo Err_cmdReportWord_Click

Dim appWord As Object
Dim path As String
Dim oTable As Table
Dim WordDoc As Word.Document
Dim strSQL As String
Dim db As Database
Dim rs As Recordset

path = Environ("USERPROFILE") & "\Desktop\my_reports\" & Forms.frm_MyRptForm.Form.txt_myRptField & ".docx"


'the docx is already open from another function, so the following applies
If Not IsRunning(appWord) Then
	Set appWord = GetObject(, "Word.Application")
	Set WordDoc = GetObject(path)
	appWord.Visible = True
Else
	Set wordDoc = GetObject(mydoc) 'from IsRunning function
End If



Set oTable = WordDoc.Tables(2) 'second table in my docx

Set db = CurrentDb
   
    strSQL = ("SELECT * FROM tbl_MyRptTable WHERE rpt_id = " & Forms.frm_MyRptForm.Form.rpt_id & "")
     
    Set rs = db.OpenRecordset(strSQL)


With oTable.Rows

If rs.EOF Then Exit Sub
	rs.MoveFirst
           
            Do While Not rs.EOF

	' I think the problem is somewhere around here, maybe.
        ' Cell(2, 1) is Row2 and Column 1... of the docx table 
        
		oTable.Cell(2, 1).Range.Text = rs.Fields("employer") 
		oTable.Cell(2, 2).Range.Text = rs.Fields("position")
		oTable.Cell(2, 3).Range.Text = rs.Fields("period")
		oTable.Cell(2, 4).Range.Text = rs.Fields("reason")


	rs.MoveNext
        Loop

    appWord.Visible = True
    appWord.Activate
   
    End With
    Set WordDoc = Nothing
    Set appWord = Nothing

Exit Sub

Err_cmdReportWord_Click:
MsgBox "My custom error message here"

Thank you.
Jamie

 

[Minty]

You aren't increasing the row number for each record so it will only keep over-writing the same row on the doc.

 

[jamie_b]

You aren't increasing the row number for each record so it will only keep over-writing the same row on the doc.

Thank you. That makes perfect sense. Looking into it now. Will post back when I have found a solution.

 

[Minty]

This is untested but something simple like

[COLOR="red"]Dim i as Integer
i = 2   ' Your first row[/COLOR]
If rs.EOF Then Exit Sub
	rs.MoveFirst
           
            Do While Not rs.EOF

	' I think the problem is somewhere around here, maybe.
        ' Cell(2, 1) is Row2 and Column 1... of the docx table 
        
		oTable.Cell([COLOR="red"]i[/COLOR], 1).Range.Text = rs.Fields("employer") 
		oTable.Cell([COLOR="red"]i[/COLOR], 2).Range.Text = rs.Fields("position")
		oTable.Cell([COLOR="red"]i[/COLOR], 3).Range.Text = rs.Fields("period")
		oTable.Cell([COLOR="red"]i[/COLOR], 4).Range.Text = rs.Fields("reason")

               
	rs.MoveNext
        [COLOR="Red"]i = i + 1[/COLOR]
        Loop

 

[jamie_b]

Solved by @Minty. Thanks mate. You make it look so easy.

Your solution worked since all the records now exports to the docx table - but only if the docx table has enough pre-formatted (pre-defined) number of rows to hold the number of records it will receive from access. Which of course is unacceptable.

So I added this to @Minty's solution and it now works as expected.

Set currentRow = oTable.Rows.Add()

Thanks again.

[COLOR="Red"]Dim i as Integer
i = 2   ' Your first row[/COLOR]

If rs.EOF Then Exit Sub
	rs.MoveFirst
           
            Do While Not rs.EOF

               [COLOR="Blue"]Set currentRow = oTable.Rows.Add()[/COLOR]

	' I think the problem is somewhere around here, maybe.
        ' Cell(2, 1) is Row2 and Column 1... of the docx table 
        
		oTable.Cell(i, 1).Range.Text = rs.Fields("employer") 
		oTable.Cell(i, 2).Range.Text = rs.Fields("position")
		oTable.Cell(i, 3).Range.Text = rs.Fields("period")
		oTable.Cell(i, 4).Range.Text = rs.Fields("reason")

               
	rs.MoveNext
       [COLOR="Red"] i = i + 1[/COLOR]
        Loop

This is untested but something simple like

[COLOR="red"]Dim i as Integer
i = 2   ' Your first row[/COLOR]
If rs.EOF Then Exit Sub
	rs.MoveFirst
           
            Do While Not rs.EOF

	' I think the problem is somewhere around here, maybe.
        ' Cell(2, 1) is Row2 and Column 1... of the docx table 
        
		oTable.Cell([COLOR="red"]i[/COLOR], 1).Range.Text = rs.Fields("employer") 
		oTable.Cell([COLOR="red"]i[/COLOR], 2).Range.Text = rs.Fields("position")
		oTable.Cell([COLOR="red"]i[/COLOR], 3).Range.Text = rs.Fields("period")
		oTable.Cell([COLOR="red"]i[/COLOR], 4).Range.Text = rs.Fields("reason")

               
	rs.MoveNext
        [COLOR="Red"]i = i + 1[/COLOR]
        Loop