Good Evening
I am trying to find out is the below question is possible.
I have a form for mailing which lists the department which the mails go to. controlled by a tick box next to each department.
I have a table named mailings, with Columns NameID;Email;reportsto
With research I have been able to put together the following code which does loop through and adds all emails from the Email Column, but what I need to do is be able to add a where command like for a Dlookup to say lookup email where reportsto = accommodation. Can this be done, I have attempted to added the additional in the Accommodationmail = Accommodationmail & rst("Email","[reportsto] = ""Accommodation""") & ";" like you would for a dlookup but it does not work.
Example of code which is selecting all email address
Private Sub AddRecipients_Click()
'On Error GoTo ErrHandler
Dim objOutlook As Object
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim rst As DAO.Recordset
Dim Accommodationmail As String
If Me.AccomTick.Value = True Then
Set rst = CurrentDb.OpenRecordset("Mailings")
Do Until rst.EOF
Accommodationmail = Accommodationmail & rst("Email") & ";"
rst.MoveNext
Loop
Accommodationmail = Left(Accommodationmail, Len(Accommodationmail) - 1)
End If
' 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(Accommodationmail)
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 = "test"
.Body = "test"
.Importance = olImportanceHigh 'High importance
' Set objOutlookAttach = .Attachments.Add()
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
'If DisplayMsg Then
.Display
' Else
' .Save
' .send
' End If
End With
Set objOutlook = Nothing
Exit Sub
'ErrHandler:
MsgBox "There has been an Error Please check your inputted Data. If Problem Persists please email with the following error: " & " " & Err.Description & " " & Err.Number
Resume Exitsub
Exitsub:
Exit Sub
End Sub
Thank you
Pjawynn
I am trying to find out is the below question is possible.
I have a form for mailing which lists the department which the mails go to. controlled by a tick box next to each department.
I have a table named mailings, with Columns NameID;Email;reportsto
With research I have been able to put together the following code which does loop through and adds all emails from the Email Column, but what I need to do is be able to add a where command like for a Dlookup to say lookup email where reportsto = accommodation. Can this be done, I have attempted to added the additional in the Accommodationmail = Accommodationmail & rst("Email","[reportsto] = ""Accommodation""") & ";" like you would for a dlookup but it does not work.
Example of code which is selecting all email address
Private Sub AddRecipients_Click()
'On Error GoTo ErrHandler
Dim objOutlook As Object
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim rst As DAO.Recordset
Dim Accommodationmail As String
If Me.AccomTick.Value = True Then
Set rst = CurrentDb.OpenRecordset("Mailings")
Do Until rst.EOF
Accommodationmail = Accommodationmail & rst("Email") & ";"
rst.MoveNext
Loop
Accommodationmail = Left(Accommodationmail, Len(Accommodationmail) - 1)
End If
' 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(Accommodationmail)
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 = "test"
.Body = "test"
.Importance = olImportanceHigh 'High importance
' Set objOutlookAttach = .Attachments.Add()
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
'If DisplayMsg Then
.Display
' Else
' .Save
' .send
' End If
End With
Set objOutlook = Nothing
Exit Sub
'ErrHandler:
MsgBox "There has been an Error Please check your inputted Data. If Problem Persists please email with the following error: " & " " & Err.Description & " " & Err.Number
Resume Exitsub
Exitsub:
Exit Sub
End Sub
Thank you
Pjawynn