Solved

best way to loop through a record set without creating an endless loop

Posted on 2016-09-14
12
36 Views
Last Modified: 2016-10-03
i am trying to go through a record set and grab some of the values for the current record then add a new record with the values from the previous record.  I am running into an endless loop and i am only getting the information from the first record that i get.
Dim db As DAO.Database
Dim rs, rs2 As DAO.Recordset
Dim strSQL, RIGACCT, ClientID, dispname, comp, acctno, bal, exp, expdel, EXPDELDATE, eq, eqdel, EQDELDATE, tu, tudel, tuddate As String
Dim pudate, crednotes, newpudate As String
Dim i As Long



strSQL = "SELECT CREDITREPORT.RIGACCT_FK, CREDITREPORT.CLIENTID_FK, CREDITREPORT.DISPLAYNAME, CREDITREPORT.COMPANYNAME, CREDITREPORT.ACCOUNTNUMBER, CREDITREPORT.BALANCE, CREDITREPORT.EXPERIAN," _
        & " CREDITREPORT.EXPERIANDEL, CREDITREPORT.EXPDELDATE, CREDITREPORT.EQUIFAX, CREDITREPORT.EQUIFAXDEL, CREDITREPORT.EQDELDATE, CREDITREPORT.TRANSUNION, CREDITREPORT.TRANSUNIONDEL, " _
        & "CREDITREPORT.TUDELDATE, CREDITREPORT.PULLEDDATE, CREDITREPORT.CREDREPORTNOTES, CREDITREPORT.NEWPULLEDDATE " _
        & " FROM CREDITREPORT " _
        & " WHERE (((CREDITREPORT.CLIENTID_FK)=" & [Forms]![SubMc_CredRptDE1Frm]![ClientID_FK] & ") and ((CREDITREPORT.PULLEDDATE)= #" & [Forms]![SubMc_CredRptDE1Frm]![PULLEDDATE_Txt] & "#));"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
With rs
    If Not rs.BOF And Not rs.EOF Then
        .MoveLast
        .MoveFirst
        Debug.Print .RecordCount
       
            Do While Not rs.EOF
               
                RIGACCT = rs!RIGacct_FK
                ClientID = rs!ClientID_FK
                DisplayName = rs!DisplayName
                comp = rs!COMPANYNAME
                acctno = rs!AccountNumber
                bal = rs!BALANCE
                exp = rs!EXPERIAN
                expdel = rs!EXPERIANDEL
                EXPDELDATE = rs!EXPDELDATE
                eq = rs!EQUIFAX
                eqdel = rs!EQUIFAXDEL
                EQDELDATE = rs!EQDELDATE
                tu = rs!TRANSUNION
                tudel = rs!TRANSUNIONDEL
              'tuddate = rs!TUDELDATE
                'pudate = Date
                crednotes = rs!CREDREPORTNOTES
                rs.AddNew
                rs!RIGacct_FK = RIGACCT
                rs!ClientID_FK = ClientID
                rs!DisplayName = DisplayName
                rs!COMPANYNAME = comp
                rs!AccountNumber = acctno
                rs!BALANCE = bal
                rs!EXPERIAN = exp
                rs!EXPERIANDEL = expdel
                rs!EXPDELDATE = EXPDELDATE
                rs!EQUIFAX = eq
                rs!EQUIFAXDEL = eqdel
                rs!EQDELDATE = EQDELDATE
                rs!TRANSUNION = tu
                rs!TRANSUNIONDEL = tudel
               'rs!TUDELDATE = tuddate
                rs!PULLEDDATE = Date
                rs!CREDREPORTNOTES = crednotes
                rs.Update
                rs.MoveNext
            Loop
        .CLOSE
0
Comment
Question by:VGuerra67
  • 3
  • 2
  • 2
  • +2
12 Comments
 
LVL 13

Expert Comment

by:John Tsioumpris
ID: 41797780
Al these are fine...the problem is that you are not providing a condition to exit the loop.
If i understand right you want to find a specific record and copy paste it to  a new record.
check if this what you want

 Dim rstClone As DAO.Recordset
    Dim rstDestination As DAO.Recordset
    Dim flds As Integer
      Set rstClone = Me.RecordsetClone
    Set rstDestination = CurrentDb.OpenRecordset(YourTable, , vbOpenDynaset)
    With rstClone
        .MoveFirst
        While Not .EOF
            rstDestination.AddNew
            
            For flds = startPoint To .Fields.Count - 1

                rstDestination.Fields(rstClone.Fields(flds).Name) = rstClone.Fields(flds)
            Next
            rstDestination.Update
            .MoveNext
        Wend
    End With
    Else
    
    End If
 set  rstDestination=nothing
set rstClone=nothing

Open in new window

0
 
LVL 49

Accepted Solution

by:
Gustav Brock earned 250 total points
ID: 41797787
First, you cannot do this:

    Dim rs, rs2 As DAO.Recordset

You must use:

    Dim rs As DAO.Recordset
    Dim rs2 As DAO.Recordset

Same procedure for your other declarations.

Second, open rs for reading only, and open rs2 for read-write.
Then read and loop rs while adding new records to rs2.

/gustav
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41797789
HI,

You could create a temporary table with the result of the select , update the date on the temp table and then append the data in the original table
to be adapted
DoCmd.RunSQL "SELECT * into Temp_table From CREDITREPORT "
DoCmd.RunSQL "Update Temp_table SET Temp_table.[myDate] = ""C"""
DoCmd.RunSQL "INSERT INTO CREDITREPORT SELECT * FROM Temp_table;"

Open in new window


Regards
0
Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

 
LVL 19
ID: 41798275
here is code you can put into a general module to loop and combine:
'~~~~~~~~~~~~~~~~ LoopAndCombine
Function LoopAndCombine( _
   psTablename As String _
   , psIDFieldname As String _
   , psTextFieldname As String _
   , pnValueID As Long _
   , Optional psWhere As String = "" _
   , Optional psDeli As String = ", " _
   , Optional psNoValue As String = "" _
   , Optional psOrderBy As String = "" _
   ) As String
's4p
'loop through recordset and combine values to one string
   
   'NEEDS REFERENCE
   'a Microsoft DAO Library
   ' -- OR --
   ' Microsoft Office #.0 Access Database Engine Object Library
   
   'PARAMETERS
   'psTablename --> tablename to get list from
   'psIDFieldname --> fieldname to link on (ie: "BookID")
   'psTextFieldname --> fieldname to combine (ie: "PageNumber")
   'pnValueID --> actual value of ID for this iteration ( ie: [BookID])
   'psWhere, Optional  --> more criteria (ie: "Year(PubDate) = 2006")
   'psDeli, Optional  --> delimiter other than comma (ie: ";", Chr(13) & Chr(10))
   'psNoValue, Optional  --> value to use if no data (ie: "No Pages")
   'psOrderBy, Optional  --> fieldlist to Order By
   
   'Set up error handler
   On Error GoTo Proc_Err
      
   'dimension variables
   Dim rs As DAO.Recordset _
      , vAllValues As Variant _
      , sSQL As String
    
   vAllValues = Null
  
   sSQL = "SELECT [" & psTextFieldname & "] " _
       & " FROM [" & psTablename & "]" _
       & " WHERE [" & psIDFieldname _
       & "] = " & pnValueID _
       & IIf(Len(psWhere) > 0, " AND " & psWhere, "") _
       & IIf(Len(psOrderBy) > 0, " ORDER BY " & psOrderBy, "") _
       & ";"
       
   'open the recordset
   Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
      
   'loop through the recordset until the end
   With rs
      Do While Not rs.EOF
         If Not IsNull(.Fields(psTextFieldname)) Then
   
            '~~~~~~~~~~~~~~~~~~~~~~~~~ CHOOSE ONE
   
            '---- if field value is numeric
            vAllValues = (vAllValues + psDeli) _
             & Trim(.Fields(psTextFieldname))
   
            '---- uncomment if you want quotes around data
            'vAllValues = (vAllValues + psDeli) _
             & " '" & Trim(.Fields(psTextFieldname)) & "'"
            '~~~~~~~~~~~~~~~~~~~~~~~~~
          End If
         .MoveNext
      Loop
   End With 'rs
      
   If Len(vAllValues) = 0 Then
      vAllValues = psNoValue
   End If
 
   
Proc_Exit:
   'close the recordset
   rs.Close
   'release the recordset variable
   Set rs = Nothing
    
   LoopAndCombine = Trim(Nz(vAllValues, ""))
   Exit Function
   
'if there is an error, the following code will execute
Proc_Err:
   MsgBox Err.Description, , _
     "ERROR " & Err.Number _
      & "   LoopAndCombine"
 
   Resume Proc_Exit
   Resume
End Function

Open in new window

then to call, here is an example of what needs to be specified:
Sub testLoopAndCombine()
'test LoopAndCombine
   Dim sTablename As String _
      , sIDFieldname As String _
      , sTextFieldname As String _
      , nValueID As Long _
      , sFieldSortBy As String
   
   sTablename = "MyTablename"
   sIDFieldname = "MyNumericForeignKeyFieldname" 'if FK is not a n umber, you will need to add delimiters to LoopAndCombine where it is referenced
   sTextFieldname = "Description of Fieldname"
   nValueID = 138 'some number you know is in the table
   sFieldSortBy = "FieldnameToSortBy"
   
   MsgBox LoopAndCombine(sTablename, sIDFieldname, sTextFieldname, nValueID, , , , sFieldSortBy)

End Sub

Open in new window

0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41798375
Augmented code
DoCmd.RunSQL "SELECT * into Temp_table" _
         & " FROM CREDITREPORT " _
         & " WHERE (((CREDITREPORT.CLIENTID_FK)=" & [Forms]![SubMc_CredRptDE1Frm]![ClientID_FK] & ") and ((CREDITREPORT.PULLEDDATE)= #" & [Forms]![SubMc_CredRptDE1Frm]![PULLEDDATE_Txt] & "#));"
DoCmd.RunSQL "UPDATE Temp_table SET Temp_table.[PULLEDDATE ] = #" & Format(Date, "MM/DD/YYYY") & "#);"
DoCmd.RunSQL "INSERT INTO CREDITREPORT SELECT * FROM Temp_table;"
DoCmd.RunSQL "DROP TABLE Temp_table;"

Open in new window

0
 
LVL 35

Assisted Solution

by:PatHartman
PatHartman earned 250 total points
ID: 41798790
You cannot read and add into the same recordset.  The .addnew is causing the recordset to be repositioned.  Use rs to read and rs2 to write.
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41821163
Hi,

I find it quite tricky that the person closing the question is the one receiving the points. Could someone else be found to close the question

Regards
0
 
LVL 49

Expert Comment

by:Gustav Brock
ID: 41821183
Pat is right, but the answer was given here: #a41797787

/gustav
0
 
LVL 35

Expert Comment

by:PatHartman
ID: 41821522
Sorry Gus.  You just mentioned the answer in passing so I missed it.  Plus others kept offering solutions.  I would have referenced your answer and just added emphasis that it was on target.  You get the points.
0

Featured Post

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question