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.
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