Access Send Email Question

[m3tallica]

Hi,

So this is what I have so far:

Private Sub Command38_click()

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
Set objOutlookRecip = .Recipients.Add

.Subject = "Instruction Required"
.Body = ""
.Importance = olImportanceHigh

Next
.Send

End Sub


Problem is, it doesn't achieve what I want it to achieve. The scenario:

A number of fields including a field containing email addresses - 'email' -
is present in the query 'Contacts'. There are roughly 7 records in this
query. I want to use this email code to send the same email to each record
in the query based on the 'email' field.

Now, the kicker is in the body of the text I need to reference other fields
present in the Contacts query - think of it as a mail merge, but not going
external and using the MS Word mail merge function in Access - so that each
email, whilst carrying the same message, is uniquely designed for each
individual record per the data in each field for that record.

Is this possible? I've tried a couple of angles but had little success.

I also realise i'm stuck here - Set objOutlookRecip = .Recipients.Add - in
getting it to add the emails present in the Contacts query. How to point it
to the right place?

I'm considering a recordset format but I need a working model as I can't
seem to work my recordset in.

Any ideas would be greatly appreciated. Thanks.

 

[Matt Williamson]

Hi,

So this is what I have so far:

Private Sub Command38_click()

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
Set objOutlookRecip = .Recipients.Add

.Subject = "Instruction Required"
.Body = ""
.Importance = olImportanceHigh

Next
.Send

End Sub


Problem is, it doesn't achieve what I want it to achieve. The scenario:

A number of fields including a field containing email addresses - 'email' -
is present in the query 'Contacts'. There are roughly 7 records in this
query. I want to use this email code to send the same email to each record
in the query based on the 'email' field.

Now, the kicker is in the body of the text I need to reference other fields
present in the Contacts query - think of it as a mail merge, but not going
external and using the MS Word mail merge function in Access - so that each
email, whilst carrying the same message, is uniquely designed for each
individual record per the data in each field for that record.

Is this possible? I've tried a couple of angles but had little success.

I also realise i'm stuck here - Set objOutlookRecip = .Recipients.Add - in
getting it to add the emails present in the Contacts query. How to point it
to the right place?

I'm considering a recordset format but I need a working model as I can't
seem to work my recordset in.

Any ideas would be greatly appreciated. Thanks.

You haven't included any code to loop through your recordset. You need
to loop through your recordset and use the email field for .to and the
field for body for .body. I'd create a separate proc for the email
portion and pass it the email address and body from the recordset as
input parameters.

Kind of like this non tested air code:


Dim oRec as ADODB.Recordset
dim sSQL as string

sSQL = "Select Email,BodyTest FROM Table"
oRec.open sSQL, CurrentProject.Connection
with oRec
do while not .eof
SendOutlookEmail(.fields("Email"), .fields("BodyTest"))
loop
end with
oRec.close
set oRec = Nothing


Public Sub SendOutlookEmail(sEmailAddress as string, sBody as string)

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
.to = sEmailAddress
.Subject = "Instruction Required"
.Body = sBody
.Importance = olImportanceHigh
.Send
end with

End Sub


HTH

Matt

 

[Matt Williamson]

Dim oRec as ADODB.Recordset
dim sSQL as string

sSQL = "Select Email,BodyTest FROM Table"
oRec.open sSQL, CurrentProject.Connection
with oRec
do while not .eof
SendOutlookEmail(.fields("Email"), .fields("BodyTest")) .movenext
loop
end with
oRec.close
set oRec = Nothing


Public Sub SendOutlookEmail(sEmailAddress as string, sBody as string)

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
.to = sEmailAddress
.Subject = "Instruction Required"
.Body = sBody
.Importance = olImportanceHigh
.Send
end with

End Sub


HTH

Matt

Forget to move to the next record. Edited inline.

 

[loulou]

This is how I send.

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach1 As Outlook.Attachment
Dim objOutlookAttach2 As Outlook.Attachment
Dim varpath As String
Dim whoto As Variant
Dim rstEmail As Recordset
Dim varMessage As String
Dim filepdf As String
Dim filepdf2 As String
DoCmd.Hourglass True
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

varpath = DLookup("[destpath]", "tblPDF_Path")

Set rstEmail = CurrentDb.OpenRecordset("qryEmail_BU")
If rstEmail.RecordCount > 0 Then
rstEmail.MoveFirst
[Forms]![frmEmailMessage]![pmessage] = "Sending Email...."
While Not rstEmail.EOF
filepdf = varpath & "/AuditSum" &
CStr(rstEmail.Fields("BUID")) & ".pdf"
filepdf2 = varpath & "/Car" & CStr(rstEmail.Fields("BUID"))
& ".pdf"
whoto = rstEmail.Fields("Emailadd")
varMessage = rstEmail.Fields("Message")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
.To = whoto
.Subject = "Quality Services - Audit Report"
.Body = varMessage & vbCrLf & vbCrLf
.Attachments.Add (filepdf)
.Attachments.Add (filepdf2)
.Save
.Send
End With
rstEmail.MoveNext
Set objOutlookMsg = Nothing
Wend
[Forms]![frmEmailMessage]![pmessage] = ""
Else
MsgBox "No Contacts to send to..."
End If