Nested Loops

Hi

I want to use a command button on my main form (ClientFrm) then loop through the subform (ContractFrm) to draw out the related records and then loop through the records in the sub form within the sub form (PaymentSubForm) for each Contract.

Main form: ClientFrm
Sub form (single form): ContractFrm
Sub form within ContractFrm (datasheet): PaymentSubForm

The word template would be set up the following way:

[Client Name]

[Contract Ref]
Payment Table Column 1 2 3

Next [Contract Ref]
Payment Table Column 1 2 3

Next [Contract Ref]
Payment Table Column 1 2 3

I have written the following code based on the help I received from GraemeSkan on this post https://www.experts-exchange.com/questions/28624031/How-can-I-export-Form-and-subform-datasheet-to-word-template.html.

However, I have made a mistake somewhere and the loop is just repeating the first Contract Record over and over again.

I would be so grateful if someone could point out where I have gone wrong.

Thanks
N

Private Sub Command36_Click()
On Error GoTo ErrorHandler
'Print customer Contract for current customer.

    Dim appWord As Word.Application
    Dim docs As Word.Documents
    Dim doc As Word.Document 'new
    Dim strLetter As String
    Dim prps As Object
   Dim strTemplateDir As String
   Dim tbl As Word.Table
    Dim daoRS1 As DAO.Recordset
      Dim daoRS2 As DAO.Recordset
  Dim myrange As Range
  

  Set appWord = GetObject(, "Word.Application")
  
  strTemplateDir = appWord.Options.DefaultFilePath(wdUserTemplatesPath)
   strTemplateDir = strTemplateDir & "\"
   Debug.Print "Office templates directory: " & strTemplateDir
   strLetter = strTemplateDir & "TableTest.dotx"
   Debug.Print "TableTest: " & strLetter
   
Set docs = appWord.Documents
Set doc = docs.Add(strLetter) 'new


Set prps = appWord.ActiveDocument.CustomDocumentProperties

With prps
.Item("Client Name") = Nz(Me![Client Name])

End With

With appWord
.Visible = True
.Activate
.Selection.WholeStory
.Selection.Fields.Update
.Selection.MoveDown Unit:=wdLine, Count:=1
End With
               

   With doc ' was docs
   Set daoRS1 = Forms!ClientFrm!ContractFrm.Form.RecordsetClone ' needs the names of the main and the sub form in here
  Set daoRS2 = Forms!ClientFrm!ContractFrm!PaymentSubform.Form.RecordsetClone ' needs the names of the main and the sub form in here

Do While Not daoRS1.EOF
daoRS1.MoveFirst
  Set myrange = .Bookmarks("\EndofDoc").Range
          With myrange
.InsertAfter Nz(Forms!ClientFrm.ContractFrm.Form.[ContractRef])
End With

               Set tbl = .Tables.Add(.Bookmarks("\EndofDoc").Range, 1, 3)
             With tbl.Rows.First
            .Cells(1).Range.Text = "Payment Number"
            .Cells(2).Range.Text = "Due Date"
            .Cells(3).Range.Text = "Amount Due"
            End With
        daoRS2.MoveFirst
        Do Until daoRS2.EOF
            Set rw = tbl.Rows.Add
            With rw
                .Cells(1).Range.Text = daoRS2.Fields("PaymentNumber")
                .Cells(2).Range.Text = daoRS2.Fields("DueDateG")
                .Cells(3).Range.Text = daoRS2.Fields("AmountDue")
            End With
            daoRS2.MoveNext
        Loop
daoRS1.MoveNext
Loop
        daoRS2.Close
 daoRS1.Close
    End With

       
   With appWord
      .Visible = True
      .Activate
      .Selection.WholeStory
      .Selection.Fields.Update
      .Selection.MoveDown Unit:=wdLine, Count:=1
   End With
    
    Set doc = Nothing
    Set appWord = Nothing
    
    Exit Sub
    
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

End Sub

Select allOpen in new window