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