Looping Through Recordset with Vba

Code to loop through all records in MS Access

You should be able to do this with a pretty standard DAO recordset loop. You can see some examples at the following links:

http://msdn.microsoft.com/en-us/library/bb243789%28v=office.12%29.aspx

http://www.granite.ab.ca/access/email/recordsetloop.htm

My own standard loop looks something like this:

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")

'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
        'Perform an edit
        rs.Edit
        rs!VendorYN = True
        rs("VendorYN") = True 'The other way to refer to a field
        rs.Update

        'Save contact name into a variable
        sContactName = rs!FirstName & " " & rs!LastName

        'Move to the next record. Don't ever forget to do this.
        rs.MoveNext
    Loop
Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "Finished looping through records."

rs.Close 'Close the recordset
Set rs = Nothing 'Clean up

Excel VBA - Loop through recordset

You used movelast before the loop so you'll need to movefirst if you want to actually iterate all the records.

Loop Through Records Access VBA

Consider:

Flight = 1
While Not rs.EOF
    If FlightCount = 10 Then
        Flight = Flight + 1
        FlightCount = 0
    End If
    FlightCount = FlightCount + 1
    If Not rs.EOF Then
        CurrentDb.Execute "Insert Into tblSession1(AthleteID, TrampFlight) Values('" & AthleteID & "',  " & Flight & ")"
        rs.MoveNext
    End If
Wend

Looping through recordset with VBA

rsSalespeople.EOF doesn't indicate when you are on the last row, it indicates when you are PAST the last row.

So when your conditional hits the last salesperson EOF is false so it does a movenext (making EOF true) then the next pass through the loop is operating on the "EOF row" of rsSalespeople which you can't pull values from, hence the error.

Try this instead:

rsSalespeople.MoveNext
If (rsSalespeople.EOF) Then
    rsSalespeople.MoveFirst
End If

Access VBA loop through SQL stored procedure recordset into subform

I ended up getting it worked out. Thank you all for your helpful comments and suggestions.

Private Function FindDuplicates()
Dim cmd As New ADODB.Command
Dim conn As ADODB.Connection
Dim prm As ADODB.Parameter
Dim strConn As String
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim dRecs As Integer

If Not Me.NewRecord Then

    strConn = "Provider=sqloledb;Server=ServerName;Database=DatabaseName;Trusted_Connection=yes;"

    Set conn = New ADODB.Connection
    conn.Open strConn

    Set cmd = New ADODB.Command
    cmd.CommandText = "sp_FindMyDuplicates"
    cmd.CommandType = adCmdStoredProc
    cmd.ActiveConnection = conn

    Set prm = cmd.CreateParameter("CID", adInteger, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("CID").Value = Me.ID

    'Execute the Stored Procedure
    cmd.Execute
    If DCount("ID", "tblCustomerDupesTemp", "ID = " & Me.ID) = 0 Then
        Me.pgDuplicates.Visible = False
    Else
        Me.pgDuplicates.Visible = True
        Me.frmCustomer_subDuplicates.Form.Filter = "[ID] <> " & Me.ID & " And [AnchorID] = " & Me.ID
        Me.frmCustomer_subDuplicates.Form.FilterOn = True
        Me.frmCustomer_subDuplicates.Form.txtDuplicateCount = CStr(Me.frmCustomer_subDuplicates.Form.CurrentRecord) & " of " & _
        DCount("ID", "tblCustomerDupesTemp", "ID <> " & Me.ID) & " Duplicate Customer(s)"
        Me.frmCustomer_subDuplicates.Form.Requery
    End If
End If
End Function

vba loop through fields in recordset while another recordset is not EOF

I have solved this problem now. The main reason I was getting incorrect values in the destination table was because using the "accountNumber" variable was not necessary. Instead I used the "AutoID" variable value as the first field on the destination table when looping through the code.

Very simple fix but it did take me a while unfortunately, hence the reason for posting as I needed an extra pair of eyes!

Working Code:

Private Sub btnTransfer_Click()

Dim dbs As DAO.Database
Dim temp As DAO.Recordset
Dim bStocked As DAO.Recordset

Dim fld As DAO.Field

Dim AutoID As String
Dim Product As String
Dim varProd As String
Dim PackSize As String
Dim priceType As String
Dim casesSold As String

Dim accountNumber As Integer
Dim counter As Integer

Set dbs = CurrentDb
Set temp = dbs.OpenRecordset("SELECT * FROM tbl_TempProducts WHERE id IS NOT NULL")
Set bStocked = dbs.OpenRecordset("SELECT * FROM tbl_BrandsStocked")

counter = 0
firstRun = True
accountNumber = 0
AutoID = 0

temp.MoveFirst

Do While temp.EOF = False

    For Each fld In temp.Fields

        If fld.Name <> "" Then

            If counter = 1 Then
                    AutoID = Nz(fld.value, "")

                If AutoID <> "" Then
                    AutoID = Nz(fld.value, "")
                    bStocked.AddNew
                    bStocked!AccountNo = AutoID
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 2 Then
                Product = Nz(fld.value, "")

                If Product <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!Brand = Product
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 3 Then
                varProduct = Nz(fld.value, "")

                If varProduct <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!Variation = varProduct
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 4 Then
                PackSize = Nz(fld.value, "")

                If PackSize <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!PackSize = PackSize
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 5 Then
                priceType = Nz(fld.value, "")

                If priceType <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked![RRP-PMP] = priceType
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If

            ElseIf counter = 6 Then
                casesSold = Nz(fld.value, "")

                If casesSold <> "" Then
                    bStocked.MoveLast
                    bStocked.Edit
                    bStocked!CPW = casesSold
                    bStocked.upDate
                Else
                    counter = counter - 1
                End If
            End If
        End If

        counter = counter + 1

        If counter >= 7 Then
            counter = 2
            bStocked.AddNew
            bStocked!AccountNo = AutoID
            bStocked.upDate
        End If

    Next

    temp.MoveNext

    counter = 0

Loop

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM [tbl_BrandsStocked] WHERE [Brand] Is null"
DoCmd.SetWarnings True

Set dbs = Nothing
Set temp = Nothing
Set bStocked = Nothing
Set fld = Nothing

End Sub

Loop through Recordset rows and paste if true

According to your comment I would suggest to use the filter method of a recordset and then use CopyFromRecordSet. No loop is needed unless you want to add the column names at the top of table.

For i = 0 To rsDatabase.Fields.Count - 1
     Range("A1").Offset(0, i) = rsDatabase.Fields(i).Name
Next i
rsDatbase.Filter = rsDatabaseCol & " = 'example'"
rsDatabase.Range("A2").CopyFromRecordset

---

Related Topics