Dear All,
I have a function as following, which send emails and attachment, My question is: is it possible to display the outlook signature in the mail body? Thanks in advance.
'code start
Sub SendReportHTML(strReportName As String, strEmail As String, strSubject As String, strFilePath As String, strFilePathPdf As String, strSendOrDisplay, Optional strAttachmentReportName As String = "")
Dim strHTML As String, strInput As String
Dim strEmailAddress As String
Const olMailItem = 0
Const olFormatHTML = 2
Dim objOlApp As Object, objOlMail As Object
Dim myAttachments As Object ' Outlook.Attachments
' If last parameter supplied,
If strAttachmentReportName <> "" Then
' Output the PDF
DoCmd.OutputTo acOutputReport, strAttachmentReportName, acFormatPDF, strFilePathPdf
End If
' Output the 1-page report to html
DoCmd.OutputTo acOutputReport, strReportName, acFormatHTML, strFilePath
' Open the resulting file
Open strFilePath For Input As #1
' Create an Outlook session
Set objOlApp = CreateObject("Outlook.Application")
' Start a new email
Set objOlMail = objOlApp.CreateItem(olMailItem)
' Read in the created HTML and put together an output string
Do While Not EOF(1) ' Loop until end of file
' Get a line from the file
Input #1, strInput
' Add it to the accumulated HTML
strHTML = strHTML & strInput
Loop
' Close the file
Close #1
' Replace lines
strHTML = Replace(strHTML, "*^*", "<hr>")
' Use the mail item for several tasks
With objOlMail
' Set the recipient
.To = strEmail
' Set the subject
.Subject = strSubject
' Tell Outlook email is in HTML format
.BodyFormat = olFormatHTML
' Add the HTML message
.HTMLBody = strHTML & vbCrLf & .HTMLBody
' Skip if no PDF specified
If strAttachmentReportName <> "" Then
' Point to the attachments of the message
Set myAttachments = .Attachments
' Add the attached file
myAttachments.Add strFilePathPdf
End If
' Send the email or Display
If strSendOrDisplay = "Send" Then
.Send
Else
.Display
End If
End With
' Clear the objects
Set objOlMail = Nothing
Set objOlApp = Nothing
' Skip errors past this point
On Error Resume Next
' Delete the two files
Kill strFilePath
Kill strFilePathPdf
End Sub
Best Regards,
Kevin
Zhao LiQing
Posted by: <zhao.liqing@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (1) |
