Need Help On Email Function

[jmthompson]

I have read just about everything on the site about emailing through access and some of it works and others do not. The problem I am having is I want to send out on email to a customer that pulls the email address from the form also included I want the customers first and last name in the body of the message and then the message. I just cannot get it figured out I have tried everything and nothing seems to work. I am semi-new at access so as much help would be great. Thanks

 

[MDJ52]

Below is the code I use to send out some 500 emails per day. The input(myrs1) is a query, the output(myrs2) records to a table all of the information that is then used by the report to be attached. I also have a version that uses a form for input, rather than a table. In that case various information comes from forms!form1!firstname rather than myrs1!firstname.

Function CreateEmail() As Variant
Dim myrs1 As DAO.Recordset
Dim myrs2 As DAO.Recordset
Dim mydb As DAO.Database
Set mydb = CurrentDb
Set myrs1 = mydb.OpenRecordset("query40_email&quot
Set myrs2 = mydb.OpenRecordset("query41&quot
Dim cagehold As String
Dim vnamehold As String
Dim vcontacthold As String
Dim vfaxhold As String
Dim NSNhold As String
Dim Faxnbr As String
Dim FaxArea As String
Dim FaxPrefix As String
Dim FaxSuffix As String
Dim Cage As Variant
Dim Company As String
Dim emailhold As String
Dim refnumhold As String
Dim Contact As Variant
Dim Chan As Variant
Dim MsgBoxOut As String
Dim Subject As Variant
Dim sddate As Variant
Dim sdtime As Variant
Dim reccount As Integer
Dim I
Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object
Dim objOutlookAttach As Object
Dim emaily As String
Dim faxy As String
Dim rfqhold As String
Dim pausetime, start
If myrs1.EOF Then GoTo NoRecords

myrs1.MoveFirst
emaily = "N"
emailhold = ""
DoCmd.SetWarnings False
DoCmd.OpenQuery "query39"
DoCmd.SetWarnings True

Do Until myrs1.EOF
If myrs1!vemail <> &quot;&quot; Then
emailhold = myrs1!vemail
refnumhold = myrs1!refnum
rfqhold = &quot;c:\my documents\&quot; & Mid(myrs1!ns, 9, 3) &
Right(myrs1!ns, 4) & &quot;.doc&quot;
myrs2.AddNew
myrs2!pricebreak = myrs1!pricebreak
myrs2!name = myrs1!name
myrs2!Contact = myrs1!Contact
myrs2!text = myrs1!text
myrs2!Quantity = myrs1!Quantity
myrs2!sctext = myrs1!sctext
myrs2!unitm = myrs1!unitmeasure
myrs2.Update
'Create the outlook session
Set objOutlook = CreateObject(&quot;Outlook.Application&quot
'Create the message
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add(emailhold)
' objOutlookRecip.Type = olTo
.Subject = myrs1!name & &quot; - Request for Quote&quot;
.body = &quot;Please complete and return the attachment
(s).&quot; & vbCrLf & vbCrLf & vbCrLf & vbCrLf & &quot;Thank you.&quot; &
vbCrLf & vbCrLf & &quot;Hoosier Ind. Supplies&quot; & vbCrLf & &quot;Email
Quotes to: mailto:quotess@hotmail.com&quot; & vbCrLf & &quot;Fax :
(219) 555-1212&quot; & vbCrLf & &quot;Voice : (219) 555-1212&quot; &
vbCrLf & vbCrLf
DoCmd.OutputTo
acOutputReport, &quot;rpt_auto_email&quot;, &quot;rich text format&quot;,
rfqhold
Set objOutlookAttach = .Attachments.Add(rfqhold)
.Send
'.display
End With
pausetime = 3
start = Timer
Do While Timer < start + pausetime
DoEvents
Loop
Kill rfqhold
DoCmd.SetWarnings False
DoCmd.OpenQuery &quot;query39&quot;
DoCmd.SetWarnings True
emailhold = &quot;&quot;
myrs1.Edit
myrs1!sent = &quot;Y&quot;
myrs1.Update
myrs1.MoveNext
End If
Loop
NoRecords:
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
Set myrs1 = Nothing
Set myrs2 = Nothing
Set mydb = Nothing

End Function