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 http://www.experts-exchange.com/Database/MS_Access/Q_28624031.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

Open in new window

nrtdAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Gustav BrockCIOCommented:
This forces your loop to start over and over:

Do While Not daoRS1.EOF
' This forces your loop to start over and over:
daoRS1.MoveFirst

Move it:

daoRS1.MoveFirst
Do While Not daoRS1.EOF

/gustav
Jeffrey CoachmanMIS LiasonCommented:
nrtd,

FWIW, ...Is this basically an "invoice"?
If this data is already in Access, you can probably create a report that looks the same, without all the overhead of looping through form recordsets and modifying Word templates

In Access you would create a simple interface to select a Client, ...then print the invoice
 (or simply print out all invoices for all clients...)

it could look something like this:
invoice
JeffCoachman
nrtdAuthor Commented:
Jeff - The field names shown are for illustration purposes only and are substitutes for the real ones which I wouldn't necessarily want in the public domain. I am creating an insurance document and this section of code only forms part of it. The whole document that I need to create cannot be achieved through a report sadly.

Gustav - Thank you for your correction, that has stopped the infite loop.

However, I am still not getting the result I need. It is showing the correct ContractRefs for each client but the table of payments that show below the ContractRef are the ones that belong to the first Contract record only. It doesn't seem to want to move past the records of payments past the first contract.

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

daoRS1.MoveFirst
Do While Not daoRS1.EOF

  Set myrange = .Bookmarks("\EndofDoc").Range
          With myrange
.InsertAfter daoRS1.Fields("[ContractRef]")
End With

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

               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

Open in new window

Acronis True Image 2019 just released!

Create a reliable backup. Make sure you always have dependable copies of your data so you can restore your entire system or individual files.

Gustav BrockCIOCommented:
That's probably because you here:

Set daoRS2 = Forms!ClientFrm!ContractFrm!PaymentSubform.Form.RecordsetClone

use the same filtered recordset for whatever is displayed on the contract form.

You will to use the (unfiltered) record source of the payment subform, then - for each loop of contract - filter it to hold the payments for this contract.

/gustav
nrtdAuthor Commented:
Thanks for the speedy reply.

If I have understood correctly I should set daoRS2 to match daoRS1 as follows:

Set daoRS2 = Forms!ClientFrm!ContractFrm.Form.RecordsetClone  

However, I then get an error message stating:

Error 3265: Description: Item not found in this collection.

Apologies if I have misunderstood what you were saying.
Gustav BrockCIOCommented:
No, it's the  record source of the payment subform, probably a query.

/gustav
PatHartmanCommented:
@nrdt,
I have an application that creates thousands of insurance documents - policies, binders, etc for an infinite number of types .  Your current method will work but it is not flexible and requires specific coding for each document type.  If you have any interest, I will give you a framework of how it works.  For obvious reasons, I can't post it.
nrtdAuthor Commented:
Gustav - I tried your suggestion and set the DaoRS2 as:
 
Set daoRS2 = Database2.OpenRecordset("SELECT [PaymentTbl].[PaymentNumber], [PaymentTbl].[DueDateG], [PaymentTbl].[AmountDue], [PaymentTbl].[ContractID] FROM PaymentQry WHERE [PaymentTbl].[ContractID] = Forms!ClientFrm!ContractFrm![ContractID]")

However, that then gives me an error message as follows:

Error 3061: Description: Too few parameters. Expected 1.
Gustav BrockCIOCommented:
Try with:


Set daoRS2 = Database2.OpenRecordset("SELECT [PaymentTbl].[PaymentNumber], [PaymentTbl].[DueDateG], [PaymentTbl].[AmountDue], [PaymentTbl].[ContractID] FROM PaymentQry WHERE [PaymentTbl].[ContractID] = " & Forms!ClientFrm!ContractFrm![ContractID] & "")

/gustav
nrtdAuthor Commented:
Thanks, that sorted the parameters error message however, it still only returns the payment records for the first contract only.

N
Gustav BrockCIOCommented:
Yes, that will be so when you filter on one ContractID. Try removing that:

Set daoRS2 = Database2.OpenRecordset("SELECT [PaymentTbl].[PaymentNumber], [PaymentTbl].[DueDateG], [PaymentTbl].[AmountDue], [PaymentTbl].[ContractID] FROM PaymentQry")

/gustav
nrtdAuthor Commented:
If I remove the filter it then gives me all the records in the query.

N
nrtdAuthor Commented:
I finally got it to work using the following:

Set DaoRS2 = Database2.OpenRecordset("SELECT [PaymentTbl].[PaymentNumber], [PaymentTbl].[DueDateG], [PaymentTbl].[AmountDue], [PaymentTbl].[ContractID] FROM PaymentQry WHERE [PaymentTbl].[ContractID] = " & daoRS1("[ContractID]") & "", dbOpenDynaset)

Thanks for your help Gustav, really appreciate it.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Gustav BrockCIOCommented:
Great. Have a nice weekend!

/gustav
nrtdAuthor Commented:
Using dbOpenDynaset was the last piece of the puzzle to make the code work properly
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.