Solved

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

Posted on 2016-09-14
12
44 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
  • 2
  • +2
12 Comments
 
LVL 17

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 51

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 52

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
Veeam gives away 10 full conference passes

Veeam is a VMworld 2017 US & Europe Platinum Sponsor. Enter the raffle to get the full conference pass. Pass includes the admission to all general and breakout sessions, VMware Hands-On Labs, Solutions Exchange, exclusive giveaways and the great VMworld Customer Appreciation Part

 
LVL 21
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 52

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 38

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 52

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 51

Expert Comment

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

/gustav
0
 
LVL 38

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

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.

Question has a verified solution.

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

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
If you need a simple but flexible process for maintaining an audit trail of who created, edited, or deleted data from a table, or multiple tables, and you can do all of your work from within a form, this simple Audit Log will work for you.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

636 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