Actually, I just went through this last week. Through some help from some smarter people than me, this is the code I came up with:
Code:
Private Sub btnEMailLeadTech_Click()
On Error GoTo Err_btnEMailLeadTech_Click
'Define some object variables for Outlook
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
'Create a reference to the email item
Dim olMailItem As Outlook.MailItem
Dim strBodyText As String
Dim strEMail As Variant
Dim Signature As String
Dim SigString As String
Dim strPathWorkOrders As String
Dim strPathTempFiles As String
Dim strAddress As String
Dim strPhone As String
Dim strLine As String
Dim intFile As Integer
Dim MyLogo As String
intFile = FreeFile()
'Create the Outlook Object
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNameSpace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olMailItem = olFolder.Items.Add("IPM.Note")
'Create the string for the email address
strEMail = DLookup("[EmpEmailAddress]", "tblEmployees", "[EmpFullName] = '" & Me.LeadTechnician & "'")
If IsNull(Me.ClientAptNumber) Then
strAddress = "<html><font face=Arial><font size=3>" & _
(Me.ClientStreetAddress & "," & "<br>" & vbCrLf & _
Me.ClientCityName & ", " & Me.ClientState & " " & Me.ClientZipCode & ".")
Else
strAddress = "<html><font face=Arial><font size=3>" & _
("# " & Me.ClientAptNumber & " - " & Me.ClientStreetAddress & "," & "<br>" & vbCrLf & _
Me.ClientCityName & ", " & Me.ClientState & " " & Me.ClientZipCode & ".")
End If
If IsNull(Me.ClientPhone2) Then
strPhone = "<html><font face=Arial><font size=3>" & _
(Me.ClientPhone1 & " (" & Me.ClientPhoneType1 & ")")
Else
strPhone = "<html><font face=Arial><font size=3>" & _
(Me.ClientPhone1 & " (" & Me.ClientPhoneType1 & ")" & "<br>" & vbCrLf & _
Me.ClientPhone2 & " (" & Me.ClientPhoneType2 & ")")
End If
'Create the string for the Work Orders Directory Path
strPathWorkOrders = DLookup("[WorkOrdersDirectoryPath]", "tblSysConfig", "[CompanyName] = '" & [Forms]![frmOrders]![CompanyName] & "'")
'Create the string for the Temp Folder for the report to go to
strPathTempFiles = DLookup("[TempFilePath]", "tblSysConfig", "[CompanyName] = '" & [Forms]![frmOrders]![CompanyName] & "'")
'Create the body text report and store in a temporary directory
DoCmd.OutputTo acOutputReport, "rptServiceDetails", acFormatHTML, strPathTempFiles & "\Order Details - " & Me.OrderNumber & _
" - " & Me.ClientUserlastName & ".html"
MyLogo = "<picture><img src='http://blah, blah, blah></picture><br>"
'Create the signature for the email
SigString = "C:\Filepath\Signatures\Wayne2.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString) & MyLogo
Else
MsgBox "Requested signature does not exist.", vbInformation
End If
'Open the report
Open strPathTempFiles & "\Order Details - " & Me.OrderNumber & " - " & Me.ClientUserlastName & ".html" For Input As #intFile
'Create the body of the message from the data in the form
If IsNull(Me.ClientNotes) Then
strBodyText = "<body><html><font face=Arial><font size=3>" & _
"As lead technician assigned to this job, here is a copy of Work Order for customer " & Me.ClientUserlastName & ", " & Me.ClientUserFirstName & "." & _
"<br><br><b><u>" & "Service Date set for:" & "</b></u><br>" & _
Format(Me.ServiceDate, "mmmm, dd, yyyy") & "." & "<br><br>" & vbCrLf & _
"<b><u>" & "Arrival/start time of: " & "</b></u><br>" & _
Format(Me.ApptTime, "h:mm AMPM") & " - " & _
Format(Me.ApptTimeEnd, "h:mm AMPM") & "." & "<br><br>" & vbCrLf & vbCrLf & _
"<b><u>" & "Job Address:" & "</b></u><br>" & vbCrLf & _
strAddress & vbCrLf & "<br>" & strPhone & "<br><br>"
Else
strBodyText = "<body><html><font face=Arial><font size=3>" & _
"As lead technician assigned to this job, here is a copy of Work Order for customer " & Me.ClientUserlastName & ", " & Me.ClientUserFirstName & "." & _
"<br><br><b><u>" & "Service Date set for:" & "</b></u><br>" & _
Format(Me.ServiceDate, "mmmm, dd, yyyy") & "." & "<br><br>" & vbCrLf & _
"<b><u>" & "Arrival/start time of: " & "</b></u><br>" & _
Format(Me.ApptTime, "h:mm AMPM") & " - " & _
Format(Me.ApptTimeEnd, "h:mm AMPM") & "." & "<br><br>" & vbCrLf & vbCrLf & _
"<b><u>" & "Job Address:" & "</b></u><br>" & vbCrLf & _
strAddress & "<br>" & vbCrLf & strPhone & "<br>" & vbCrLf & vbCrLf & _
"<u><b>" & "Special Notes:" & "</u></b>" & "<br>" & Me.ClientNotes & "<br><br>"
End If
'Add in the report to the body of the email
Do While Not EOF(intFile)
Line Input #intFile, strLine
strBodyText = strBodyText & strLine
Loop
Close #intFile
'Attach the work order to the email
If Len(Dir(strPathWorkOrders & "\" & Me.OrderNumber & " " & _
Me.ClientUserlastName & " POD" & ".pdf")) = 0 Then
MsgBox "The Work Order you are trying to attach does not exist in the directory selected.", vbInformation
Exit Sub
End If
If IsNull(Me.ApptTime) Then
MsgBox "You haven't entered an appointment start time. You must have a start time.", vbInformation
Exit Sub
Else
'Update the new email object with the form data
With olMailItem
.Subject = Me.OrderNumber & " - " & Me.ClientUserlastName & ", " & Me.ClientUserFirstName
.To = Replace(Mid(strEMail, InStr(1, strEMail, ":") + 1), "#", "")
.BCC = "MyEMail"
.ReadReceiptRequested = True
.HTMLBody = strBodyText & "</body></html><br>" & Signature
.Importance = olImportanceHigh
.Display
.Attachments.Add strPathWorkOrders & "\" & Me.OrderNumber & " " & _
Me.ClientUserlastName & " POD" & ".pdf"
End With
End If
'Release all of the object variables
Set olMailItem = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
'Get rid of the temporary file
Kill (strPathTempFiles & "\Order Details - " & Me.OrderNumber & " - " & Me.ClientUserlastName & ".html")
Exit_btnEMailLeadTech_Click:
Exit Sub
Err_btnEMailLeadTech_Click:
MsgBox Err.Description, vbInformation
Resume Exit_btnEMailLeadTech_Click
End Sub
It does put the report in the body of the email message, but it is for only one email at a time. You can put a looping routine in to send it to all recipients. Instead of .To in the message, you could use .Recipients for the email addresses.
Hope this helps.
Wayne