Rabu, 31 Oktober 2018

[MS_AccessPros] is it possible to display the outlook signature in the mail body?

 

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)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


SPONSORED LINKS
.

__,_._,___

Tidak ada komentar:

Posting Komentar