Here is greatly abbreviated code. I took out lots of things that are irrelevant and just add confusion. I even edited out the actual email body text. I'm trying to keep what I send to a bare minimum.
As I said, ultimately only one email is generated but the body and to: field of the first is overwritten by the second. Interestingly, I have the same document attached twice to the single mail as well.
I appreciate you reviewing this for me.
Private Sub EMailQuote_Click()
Dim wobj As Word.Application
Dim strFN As String, strEmail As String, strDealerEmail As String, strFullEmail As String
Dim strSubject As String, strBody As String
Dim I As Long, X As String, strReturn As String
Dim strFaxage As String
Dim strFaxageEmail As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strAttach1 As String
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
On Error GoTo ErrHandler:
Me.Refresh
strFullEmail = ""
strEmail = ""
strDealerEmail = ""
strReturn = ""
If Len(Me.EMail) > 2 Then
strEmail = Nz(Me.EMail, "") & ";"
End If
If Me.DealerEMail Like "*@*" Then
strDealerEmail = Nz(Me.DealerEMail, "") & ";"
End If
If Screen.ActiveForm![DealerFax] Like "(*" Then
For I = 1 To Len(DealerFax)
X = Mid(DealerFax, I, 1)
If X Like "[0-9]" Then
strReturn = strReturn & X
End If
Next
If Len(strReturn) > 2 Then
strReturn = strReturn & "@faxage.com;"
End If
End If
strDealerEmail = strDealerEmail & strReturn 'Sets Dlr Email
strFullEmail = strDealerEmail & strEmail 'sets email for dlr and cust
'End new email address routine
strSubject = IIf(DLookup("[Ignore]", "[Dealers]", "[DealerID]=Screen.ActiveForm!DealerID") = False, Trim(Replace(Screen.ActiveForm![Dlr], "*", "")) & _
" is providing " & First & " " & Last & " a", First & " " & Last & "'s") & " complimentary insurance quotation" & _
IIf(DLookup("[Ignore]", "[Dealers]", "[DealerID]=Screen.ActiveForm!DealerID") = False, Null, " from American " & _
"Adventure Insurance")
Me.Refresh
Me.Refresh
If MsgBox("Do you want to edit the Word document before sending?", vbYesNo, "Confirm Document Edit") = vbYes Then
Set wobj = CreateMDoc()
strFN = CreatePDF(wobj)
Me.Refresh
Exit Sub
Else
Set wobj = CreateMDoc()
strFN = CreatePDF(wobj)
With objEmail
'.To = [TempVars]![EMailAdd].Value
If DLookup("[DSExists]", "[DSExists]") = True And Len(Me.EMail) > 2 Then 'send dealer text only to dealer if ds and No cust email
.To = strDealerEmail
End If
If DLookup("[DSExists]", "[DSExists]") = False Then 'send same text to all if no DS
.To = strFullEmail
End If
.Subject = strSubject
.HTMLBody = "<head>" & "<style> .indented { padding-left: 50pt; padding-right: 10pt; } </style>" & "</head>" & "<p style='font-family:verdana;font-size:12'>" & _
"Hello Mail 1"
.Display
.Attachments.Add strFN
End With
Kill strFN
Me.Refresh
wobj.Application.Quit False
Set wobj = Nothing
Set objOutlook = Nothing
End If
If DLookup("[DSExists]", "[DSExists]") = True And Len(Me.EMail) > 2 Then 'DS veh and sends only to cust email address
Set wobj = CreateMDoc()
strFN = CreatePDF(wobj)
With objEmail
.To = strEmail
.Subject = strSubject
.HTMLBody = "<head>" & "<style> .indented { padding-left: 50pt; padding-right: 10pt; } </style>" & "</head>" & "<p style='font-family:verdana;font-size:12'>" & _
"Hello Mail2"
.Display
.Attachments.Add strFN
End With
Kill strFN
Me.Refresh
wobj.Application.Quit False
Set wobj = Nothing
End If
Set objOutlook = Nothing
ErrHandler:
DoCmd.SetWarnings True
If TempVars!ErrorHandler = "Error" Then
clipboard.SetText TempVars!ShortAppName
clipboard.PutInClipboard
Me.Refresh
DoCmd.RunMacro "Control2.Timer"
TempVars!AllowOpen.Value = Null
Else
If Err.Number = 2501 Then
Application.Echo True
TempVars!AllowOpen.Value = Null
Exit Sub
End If
End If
End Sub
