Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

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

Posted on 2016-09-14
12
Medium Priority
?
50 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
9 Comments
 
LVL 19

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 52

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
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
LVL 23
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 40

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 52

Expert Comment

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

/gustav
0
 
LVL 40

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

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

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.
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Suggested Courses

877 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