Email multiple lines from query to 1 recipient
I have some VBA that pulls in a query and sends an email to the requestor.
I would like that same coding to loop through the query data to send multiple lines to one email recipient. Meaning 1 person could submit multiple invoice lines so in the body of the email I would like the multiple invoice numbers listed out per recipient. See coding below.
Currently for each invoice submitted the employee receives multiple emails
I have some VBA that pulls in a query and sends an email to the requestor.
I would like that same coding to loop through the query data to send multiple lines to one email recipient. Meaning 1 person could submit multiple invoice lines so in the body of the email I would like the multiple invoice numbers listed out per recipient. See coding below.
Currently for each invoice submitted the employee receives multiple emails
Code:
Public Sub SendMail()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSubject As String
Dim strEmailAddress As String
Dim strEMailMsg As String
Dim ingCounter As Integer
Dim intCount As Integer
Dim aOutlook As Object
Dim aEmail As Object
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Email")
'Count of unsent e-mails
intCount = DCount("[ID]", "[PRF]" _
, "[Notified]=0")
'If count of unsent e-mails is zero then the procedure will not run
'If count of unsent e-mails is greater than zero, msgbox will prompt
'to send mail.
If intCount = 0 Then
MsgBox ("You have " & intCount & " emails to send.") _
, vbInformation, "Posted PRF"
Exit Sub
Else
rst.MoveFirst
Do Until rst.EOF
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
With aEmail
.Display
End With
signature = aEmail.Body
aEmail.Subject = "Posted payment Request"
strEmailAddress = rst![EmployeeEmail]
aEmail.Body = "Invoice Number: " & rst![Invoice Number] & "" & " - " & "Vendor Name: " & rst![Vendor Name] & vbNewLine & signature
aEmail.To = strEmailAddress
aEmail.Send
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
'
'Run update to update the sent mail check box
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE PRF SET PRF.Notified = -1 WHERE (((PRF.Notified)=0))"
DoCmd.SetWarnings True
MsgBox "All new Emails have been sent for posted PRF", vbInformation, "Thank You"
End If
Last edited: