I have this code that works perfectly except that in the Message/Body of the email it sends out each invoice to every employee, rather than just sending the invoices related to each employee.
Public Sub SendMail2() Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim strSubject As String Dim strEmailAddress As String Dim strEMailMsg As String Dim intCount As Integer Dim aOutlook As Object Dim aEmail As Object Dim sSQL As String Dim bFirstTime As Boolean 'Count of unsent e-mails intCount = DCount("[ID]", "[PRF]", "[Notified]=0") If intCount = 0 Then 'If count of unsent e-mails is zero then the procedure will not run MsgBox ("You have " & intCount & " emails to send."), vbInformation, "Posted PRF" Exit Sub Else ' Setup email loop bFirstTime = True ' Don't attempt to send an email before it's ready. Set aOutlook = CreateObject("Outlook.Application") ' Only need to do this once sSQL = "SELECT * FROM Email ORDER BY EmployeeEmail, [Vendor Name]" Set dbs = CurrentDb Set rst = dbs.OpenRecordset(sSQL) ' Loop through Invoices If Not rst.EOF Then Do While Not rst.EOF If strEmailAddress <> rst![EmployeeEmail] Then ' EmployeeEmail has changed, ' So send off the current Email (if there is one) ' and create a New one. If Not bFirstTime Then ' Send off previously created Email strEmailAddress = rst![EmployeeEmail] aEmail.Body = strEMailMsg aEmail.Send Else bFirstTime = False End If ' Create new Email strEmailAddress = rst![EmployeeEmail] Set aEmail = aOutlook.CreateItem(0) aEmail.To = strEmailAddress aEmail.Subject = "Posted payment Request" aEmail.Display End If ' Add Invoice to current Email strEMailMsg = strEMailMsg & "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & vbNewLine rst.MoveNext Loop If Not bFirstTime Then ' Send Last email, since this hasn't been done yet. aEmail.Body = strEMailMsg aEmail.Send End If End If ' Cleanup. Don't worry about the DB Reference rst.Close Set rst = Nothing 'Run update to update the sent mail check box sSQL = "UPDATE PRF SET PRF.Notified = -1 WHERE (((PRF.Notified)=0))" dbs.Execute sSQL MsgBox "All new emails have been sent for posted PRF", vbInformation, "Thank You" End If 'End If End Sub