Recordsets

[RevJeff]

Hello everyone. I am new to Recordsets and Looping. I will try to explain this as best as I can. I have a table with two columns, Phone Numbers and Drivers Times:

CellExt DriverTime
3335551234@vtext.com Louden 5:30
3335551234@vtext.com Garner 2:00
3335551234@vtext.com Wells 5:00
3335551234@vtext.com Cox 5:00
3335551234@vtext.com Cade 4:00
3335551234@vtext.com Beukes 5:30
3335551234@vtext.com Tindal 3:00
3335551234@vtext.com Hughes 4:00
2225554321@vtext.com Louden 5:30
2225554321@vtext.com Garner 2:00
2225554321@vtext.com Wells 5:00
2225554321@vtext.com Cox 5:00
2225554321@vtext.com Cade 4:00
2225554321@vtext.com Beukes 5:30
2225554321@vtext.com Tindal 3:00
2225554321@vtext.com Hughes 4:00

So in the first column there are two sets of phone numbers, 3335551234@vtext.com and 2225554321@vtext.com and next to those numbers are the drivers names and start times.

What I am trying to accomplish is to loop through the CellExt field and as long as it is the same number I want to combine the DriverTime column together like: "Louden 5:30 Garner 2:00 Wells 5:00 Cox 5:00 Cade 4:00 Beukes 5:30 Tindal 3:00 Hughes 4:00".

Then it exits the loop and email the combined DriverTime field to the Shuttle Guy. Up to that point it works great, but after it sends the first email, it is supposed to loop back up to the top and continue on where it left off starting with the next CellExt number in the list, 2225554321@vtext.com. But it doesn't. What happens is I get an error saying, Run-time error '3021': No current record" and Debug highlights this line in the code: Do Until rs.Fields("CellExt") <> Cell

Private Sub Command44_Click()

Dim rs As DAO.Recordset
Dim strSQL As String
Dim Cell As String
Dim Text As String
Set db = CurrentDb

strSQL = "SELECT CellExt, DriverTime FROM tblShuttle"
Set rs = db.OpenRecordset(strSQL)

rs.MoveFirst
Cell = ""
NextCell = ""


Do Until rs.EOF
        Cell = rs.Fields("CellExt")
        Text = ""
        
    Do Until rs.Fields("CellExt") <> Cell
        Text = Text & " " & rs.Fields("DriverTime")
        rs.MoveNext
    Loop
            
        Dim MyRs As DAO.Recordset
        Dim strAddr
        Dim strSubject
        Dim strBody
        Dim oOutlook As Outlook.Application
        Dim oEmailItem As MailItem
   
        With MyRs

        strAddr = Cell
        strSubject = "Dispatch"
        strBody = Text

        Set oOutlook = GetObject(, "Outlook.Application")
        If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")
         
        Set oEmailItem = oOutlook.CreateItem(olMailItem)
         
        With oEmailItem
            .To = strAddr
            .Subject = strSubject
            .Body = strBody
            .Send
        End With
         
        Set oEmailItem = Nothing
        Set oOutlook = Nothing
        
        End With

Loop

Set rs = Nothing
Set db = Nothing

End Sub

 

[pbaldy]

I personally would not loop within a loop of the same data. I'd keep track of the change of value, send the email at that point, reset the variables and continue with the same loop.

 

[ByteMyzer]

Hello, RevJeff,

Your outer loop checks for EOF on the recordset, but your inner loop needs to check for it also. Might I suggest the following amendment to the inner loop?

    [COLOR="Navy"]Do Until[/COLOR] rs.Fields("CellExt") <> Cell
        Text = Text & " " & rs.Fields("DriverTime")
        [b][i][COLOR="navy"]If[/COLOR] rs.EOF = [COLOR="navy"]True Then Exit Do[/COLOR][/i][/b]
        rs.MoveNext
    [COLOR="navy"]Loop[/COLOR]

 

[RevJeff]

ByteMyzer, thank you for the advice. I have added that EOF check.

pbaldy, Like I said, I am new to Recordset and Looping. Can you explain what you mean?

Thank you both for responding!

 

[arnelgp]

Almost but you have to test Eof after moving the record pointer:

Do Until rs.Fields("CellExt") <> Cell
Text = Text & " " & rs.Fields("DriverTime")

rs.MoveNext

If rs.EOF = True Then Exit Do
Loop

 

[RevJeff]

arnelgp, Thank you! That did the trick!

 

[arnelgp]

Your welcome Reverend.

 

[ByteMyzer]

@arnelgp

Ahh, you're right, my bad, I misfired on the line insert. Thank you for the correction.