B
bnotions
I am trying to achieve the following in a module. I currently have a
module that sends out reports via emails. However, the names of the
recipients are hard coded into the module. I want to have the module
create a list from a table that I built containing the names of the
recipients. So here is the what I have:
-------------------------------------------------------------------------------------------------------------------
This is the query that will return the results I require:
SELECT REPORTS_DESTRIBUTION_LIST.rdl_name
FROM REPORTS_DESTRIBUTION_LIST
WHERE (((REPORTS_DESTRIBUTION_LIST.rdl_fx_active_list) Like True));
-------------------------------------------------------------------------------------------------------------------
This is the function that sends the email. I need to have the query
above included to build the list of recipients, then plug it into the
"TO:" section of the email.
Function sendmessageActive(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("*** PLUG QUERY RESULTS
HERE ***")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("")
'objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = "FX Active Clients Report - COB " & IIf(Weekday(Now()
- 1) = 1 Or Weekday(Now() - 1) = 7, Date - 3, Date - 1)
.Body = "All," & vbCrLf & vbCrLf
.Body = .Body & "Please find report attached." & vbCrLf & vbCrLf
.Body = .Body & "Regards," & vbCrLf & vbCrLf
.Body = .Body &
"----------------------------------------------------------------------"
& vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Function
module that sends out reports via emails. However, the names of the
recipients are hard coded into the module. I want to have the module
create a list from a table that I built containing the names of the
recipients. So here is the what I have:
-------------------------------------------------------------------------------------------------------------------
This is the query that will return the results I require:
SELECT REPORTS_DESTRIBUTION_LIST.rdl_name
FROM REPORTS_DESTRIBUTION_LIST
WHERE (((REPORTS_DESTRIBUTION_LIST.rdl_fx_active_list) Like True));
-------------------------------------------------------------------------------------------------------------------
This is the function that sends the email. I need to have the query
above included to build the list of recipients, then plug it into the
"TO:" section of the email.
Function sendmessageActive(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("*** PLUG QUERY RESULTS
HERE ***")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("")
'objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = "FX Active Clients Report - COB " & IIf(Weekday(Now()
- 1) = 1 Or Weekday(Now() - 1) = 7, Date - 3, Date - 1)
.Body = "All," & vbCrLf & vbCrLf
.Body = .Body & "Please find report attached." & vbCrLf & vbCrLf
.Body = .Body & "Regards," & vbCrLf & vbCrLf
.Body = .Body &
"----------------------------------------------------------------------"
& vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Function