You might be able to adapt this subroutine to do what you want. This SBR
loops thru a dataset and sends an e-mail to each one of them. It can then be
called from wherever it is needed...
Hopefully it's not too much of a pain to decipher.....
Sub SendMessagesAll(Interval As Integer, Optional AttachmentPath)
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Dim RecCount As Integer
Set MyDB = CurrentDb()
Select Case Interval
Case 30
Set MyRS = MyDB.OpenRecordset("qryEMailList_30")
RecCount = DCount("", "qryEMailList_30", Not Null)
MyRS.MoveFirst
Case 60
Set MyRS = MyDB.OpenRecordset("qryEMailList_60")
RecCount = DCount("[EMail]", "qryEMailList_60", Not Null)
MyRS.MoveFirst
Case 90
Set MyRS = MyDB.OpenRecordset("qryEMailList_90")
RecCount = DCount("[EMail]", "qryEMailList_90", Not Null)
MyRS.MoveFirst
Case 999
Set MyRS = MyDB.OpenRecordset("qryExpired_All")
RecCount = DCount("[EMail]", "qryExpired_All", Not Null)
MyRS.MoveFirst
End Select
Msg = "You are about to send " & RecCount & " E-Mail(s) via your Outlook
Client... Continue?" ' Define message.
Style = vbYesNo ' Define buttons.
Title = "Send E-Mails" ' Define title.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
Exit Sub
End If
Msg = "Are you sure? " & RecCount & " E-Mail(s)...( ! )" ' Define message.
Style = vbYesNo ' Define buttons.
Title = "Send E-Mails" ' Define title.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
Exit Sub
End If
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Do Until MyRS.EOF
TheAddress = MyRS![EMAIL]
With objOutlookMsg
' Add the To recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
' Set the Subject, the Body, and the Importance of the e-mail
message.
.Subject = Forms!frmEMailtoExpire!txtSubject
.Body = Forms!frmEMailtoExpire!txtMessage
.Importance = olImportanceHigh 'High importance
'Add the attachment to the e-mail message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve the name of each Recipient.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
--
Frank Bachman
(Grumpy Aero Guy)
[QUOTE="J B via AccessMonster.com"]
I need to send mutiple emails to different users. i have an autoexec macro
that sends a query as an email in the 'To' field I use this expression
=[Forms]![Tool Box Cleaning Query]![Employees.EmployeeID]
whereas the employee ID is an email address how can I change this
expression
to send the email for email address' from the next record in my query.
Currently it will only recognise the first email.
Thanks,
Jerry
[/QUOTE]
