Solved Rec.MoveNext not working? (1 Viewer)

K

kevnaff

Member
Local time
Today, 05:30
Joined
Mar 25, 2021
Messages
171
Hi All.

I have the below code to look at a query and create an automatic email containing data from the query. There are currently only two records in the query.

When I click on the command button, my message box works OK and tells me that it has found two records, from the Rec.RecordCount.

It then runs through the rest of the code and creates two emails, however the data in the two emails is from the first record, and it does not pick any data from the second record in the query.

I can't seem to figure out where I'm going wrong. It seems that the Rec.MoveNext may be the issue, due to it not entering the data from the second record from the query. However as it creates two emails this may not be the case.

Can anybody help spot why this may be the case?

Thanks in advance.

Code: 
    Dim db As DAO.Database
    Dim REC As Recordset
    Dim reportName As String
    Dim criteria As String
    Dim MSG As String
    Dim O As Outlook.Application
    Dim M As Outlook.MailItem
    Dim FolderPath As String, fileName As String
    Dim TotalRecords As Integer
    Dim n As Integer
    
    
    ' Count records in found set
Set db = CurrentDb()
Set REC = db.OpenRecordset("QueryHiresOverdue", dbOpenDynaset)
REC.MoveLast
TotalRecords = REC.RecordCount
REC.Close

' Get out message
Message = "MediPool will Automatically send " & TotalRecords & _
            " overdue reminder emails" _
            & Chr(10) & "Do you wish to continue?"
Title = "MediPool Auto Emails"
Response = MsgBox(Message, vbOKCancel, Title)
If Response = vbCancel Then GoTo Exit_CommandOverdueEmails_Click



Set db = CurrentDb()
Set REC = db.OpenRecordset("QueryHiresOverdue", dbOpenDynaset)

For n = 1 To TotalRecords


    MSG = "An Equipment Pool hire item that is assigned to " & Me.[Ward] & " - Bed Space " & Me.[BedSpaceNumber] & " - is due for returning." & "<p>" & "This hire is currently costing your Ward £" & Me.[CostPerDay] & " per day, and has costed £" & Me.[HireCostSoFar] & " in total so far." & "<p>" & "Hire Item Details:" & "<p>" & "Device Type - " & Me.[DeviceType] & "" & "<p>" & "Model - " & Me.[Model] & "" & "<p>" & "Supplier - " & Me.[HiredFrom] & "" & "<p>" & "Serial Number - " & Me.[SerialNumber] & "" & "<p>" & "If you have finished with this hire, please arrange with the Porters on Extension 1188 to return it to the Equipment Pool." & "<p>" & "Thanks" & "<p>" & "Equipment Pool"
    
'Remember to add REFERENCE to Microsoft Outlook Object Library

    
    
    Set O = New Outlook.Application
    Set M = O.CreateItem(olMailItem)
    
    With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MSG
        .To = DLookup("[HousekeeperName]", "LookupDepartment", "Depart=Ward")
        .CC = DLookup("[DeptHead]", "LookupDepartment", "Depart=Ward")
        .Subject = "Hire Equipment Overdue For Returning"
        .Display
    End With
    

    
REC.MoveNext
Next n

REC.Close
    
    
    'Completed Message
Message = TotalRecords & " emails have automatically been sent by MediPool"
Title = "MediPool Auto Emails"
Response = MsgBox(Message, vbOK, Title)
    
    
Exit_CommandOverdueEmails_Click:
    Exit Sub
 
moke123

moke123

AWF VIP
Local time
Today, 00:30
Joined
Jan 11, 2013
Messages
4,061
Where are you using the recordset?
I would expect to see Rec!Somefield somewhere.
 
K

kevnaff

Member
Local time
Today, 05:30
Joined
Mar 25, 2021
Messages
171
moke123 said:
Where are you using the recordset?
I would expect to see Rec!Somefield somewhere.
Click to expand...

Thanks!

It's so simple now you say it ha.

I have replaced all instances in MSG of Me.[field] with REC("FIELD") and it works perfect.
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 00:30
Joined
May 21, 2018
Messages
8,755
Code is a little redundant. The normally way to loop a RS is to go until EOF. No reason to set the DB twice, the RS twice, and create an outlook application for each record. Also this code fails if no records returned by the RS.
Maybe something like:
Code: 
Public Sub test()
   Dim db As DAO.Database
    Dim REC As Recordset
    Dim reportName As String
    Dim criteria As String
    Dim MSG As String
    Dim O As Outlook.Application
    Dim M As Outlook.MailItem
    Dim FolderPath As String, fileName As String
    Dim TotalRecords As Integer
    Dim n As Integer
   
   
    ' Count records in found set
  Set db = CurrentDb()
  Set REC = db.OpenRecordset("QueryHiresOverdue", dbOpenDynaset)

  'Ensure not EOF or you will throw an error
  If Not REC.EOF Then
    REC.MoveLast
    REC.MoveFirst
    TotalRecords = REC.RecordCount
    Set O = New Outlook.Application
  else
    Msgbox "No overdue records",vbinformation
    exit sub
  end if
   
' Get out message
    Message = "MediPool will Automatically send " & TotalRecords & _
                " overdue reminder emails" _
                & Chr(10) & "Do you wish to continue?"
    Title = "MediPool Auto Emails"
    Response = MsgBox(Message, vbOKCancel, Title)
    If Response = vbCancel Then GoTo Exit_CommandOverdueEmails_Click

  Do While Not REC.EOF

    MSG = "An Equipment Pool hire item that is assigned to " & Me.[Ward] & " - Bed Space " & Me.[BedSpaceNumber] & " - is due for returning." & "<p>" & "This hire is currently costing your Ward £" & Me.[CostPerDay] & " per day, and has costed £" & Me.[HireCostSoFar] & " in total so far." & "<p>" & "Hire Item Details:" & "<p>" & "Device Type - " & REC.[DeviceType] & "" & "<p>" & "Model - " & REC.[Model] & "" & "<p>" & "Supplier - " & REC.[HiredFrom] & "" & "<p>" & "Serial Number - " & REC.[SerialNumber] & "" & "<p>" & "If you have finished with this hire, please arrange with the Porters on Extension 1188 to return it to the Equipment Pool." & "<p>" & "Thanks" & "<p>" & "Equipment Pool"
    Set M = O.CreateItem(olMailItem)
    With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MSG
        .To = DLookup("[HousekeeperName]", "LookupDepartment", "Depart=Ward")
        .CC = DLookup("[DeptHead]", "LookupDepartment", "Depart=Ward")
        .Subject = "Hire Equipment Overdue For Returning"
        .Display
    End With
   REC.MoveNext
Loop
REC.Close
    'Completed Message
Message = TotalRecords & " emails have automatically been sent by MediPool"
Title = "MediPool Auto Emails"
Response = MsgBox(Message, vbOK, Title)
Exit_CommandOverdueEmails_Click:
    Exit Sub
End Sub
 
K

kevnaff

Member
Local time
Today, 05:30
Joined
Mar 25, 2021
Messages
171
MajP said:
Code is a little redundant. The normally way to loop a RS is to go until EOF. No reason to set the DB twice, the RS twice, and create an outlook application for each record. Also this code fails if no records returned by the RS.
Maybe something like:
Code: 
Public Sub test()
   Dim db As DAO.Database
    Dim REC As Recordset
    Dim reportName As String
    Dim criteria As String
    Dim MSG As String
    Dim O As Outlook.Application
    Dim M As Outlook.MailItem
    Dim FolderPath As String, fileName As String
    Dim TotalRecords As Integer
    Dim n As Integer
  
  
    ' Count records in found set
  Set db = CurrentDb()
  Set REC = db.OpenRecordset("QueryHiresOverdue", dbOpenDynaset)

  'Ensure not EOF or you will throw an error
  If Not REC.EOF Then
    REC.MoveLast
    REC.MoveFirst
    TotalRecords = REC.RecordCount
    Set O = New Outlook.Application
  else
    Msgbox "No overdue records",vbinformation
    exit sub
  end if
  
' Get out message
    Message = "MediPool will Automatically send " & TotalRecords & _
                " overdue reminder emails" _
                & Chr(10) & "Do you wish to continue?"
    Title = "MediPool Auto Emails"
    Response = MsgBox(Message, vbOKCancel, Title)
    If Response = vbCancel Then GoTo Exit_CommandOverdueEmails_Click

  Do While Not REC.EOF

    MSG = "An Equipment Pool hire item that is assigned to " & Me.[Ward] & " - Bed Space " & Me.[BedSpaceNumber] & " - is due for returning." & "<p>" & "This hire is currently costing your Ward £" & Me.[CostPerDay] & " per day, and has costed £" & Me.[HireCostSoFar] & " in total so far." & "<p>" & "Hire Item Details:" & "<p>" & "Device Type - " & REC.[DeviceType] & "" & "<p>" & "Model - " & REC.[Model] & "" & "<p>" & "Supplier - " & REC.[HiredFrom] & "" & "<p>" & "Serial Number - " & REC.[SerialNumber] & "" & "<p>" & "If you have finished with this hire, please arrange with the Porters on Extension 1188 to return it to the Equipment Pool." & "<p>" & "Thanks" & "<p>" & "Equipment Pool"
    Set M = O.CreateItem(olMailItem)
    With M
        .BodyFormat = olFormatHTML
        .HTMLBody = MSG
        .To = DLookup("[HousekeeperName]", "LookupDepartment", "Depart=Ward")
        .CC = DLookup("[DeptHead]", "LookupDepartment", "Depart=Ward")
        .Subject = "Hire Equipment Overdue For Returning"
        .Display
    End With
   REC.MoveNext
Loop
REC.Close
    'Completed Message
Message = TotalRecords & " emails have automatically been sent by MediPool"
Title = "MediPool Auto Emails"
Response = MsgBox(Message, vbOK, Title)
Exit_CommandOverdueEmails_Click:
    Exit Sub
End Sub
Click to expand...

Thanks for your help I will give this a go.
 
You must log in or register to reply here.

Similar threads

K
Solved strSql - Object Required
Replies
11
Views
197
Minty
Minty
A
Solved Auto email error needed if attachment file doesn't exist or is named incorrectly
Replies
3
Views
277
theDBguy
theDBguy
A
Solved Problems with code execution following email
Replies
19
Views
481
Pat Hartman
P
L
Runtime Error 2147467259 (80004005)
Replies
11
Views
936
The_Doc_Man
The_Doc_Man
S
Refine a working regex exclude periods or dots except if a decimal
Replies
10
Views
884
DickyP
DickyP

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom