Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2016-09-14
12
Medium Priority
?
49 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 18

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 1000 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 53

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 Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

 
LVL 22
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 53

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 39

Assisted Solution

by:PatHartman
PatHartman earned 1000 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 53

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 39

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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

670 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