Adding signature to email through access

L

lilbit27

I'm have automated the creation of an email from Access; whic works
fine,
but the new email doesn't have the user's default signature on it. Is
there any way to either have it find the user's default signature and
add it to the bottom of the email.

Here is my code for sending the emails:

Function SendEmail()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strMessage As String

Dim strTableBeg As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strFntHeader As String
Dim strFntEnd As String

' Define format for output
------------------------------------------------
strTableBeg = "<table border=0>"
strTableEnd = "</table>"
strFntHeader = "<font size=2 face=" & Chr(34) & "Arial" & Chr(34) &
"><b>" & _
"<tr bgcolor=lightblue>" & _
"<td nowrap>Insured</td>" & _
"<td>Policy</td>" & _
"<td>SP Policy</td>" & _
"<td>Trans Type</td>" & _
"<td>Eff. Date</td>" & _
"<td align=center>Gross</td>" & _
"<td align=center>Commission</td>" & _
"<td align=center>Net</td>" & _
"</tr></b></font>"
strFntNormal = "<font color=black face=" & Chr(34) & "Arial" & Chr(34)
& " size=1>"
strFntEnd = "</font>"

' HEADER LINES
-----------------------------------------------------------
strMessage = strTableBeg & strFntNormal & strFntHeader

' DETAIL LINES
-----------------------------------------------------------
strSQL = "SELECT InsName,Policy,SpcPol,TranType,BillEffdte,Gross,Comm
" & _
"FROM TARA " & _
"WHERE check = True and TARA.Email = fOSUserName()"
Set rst = CurrentDb.OpenRecordset(strSQL)

Do Until rst.EOF
strMessage = strMessage & _
"<tr>" & _
"<td>" & rst!InsName & "</td>" & _
"<td>" & rst!Policy & "</td>" & _
"<td>" & rst!SpcPol & "</td>" & _
"<td>" & rst!TranType & "</td>" & _
"<td>" & rst!BillEffDte & "</td>" & _
"<td align=right>" & Format(rst!Gross, "currency") & "</td>" & _
"<td align=right>" & Format(rst!Comm, "currency") & "</td>" & _
"<td align=right>" & Format(rst!Gross - rst!Comm, "currency") & "</
td>" & _
"</tr>"
rst.MoveNext
Loop

rst.Close
Set rst = Nothing

' TOTALS LINE
-------------------------------------------------------------
strSQL = "SELECT Sum(TARA.Gross) AS SumOfGross, " & _
"Sum(TARA.Comm) AS SumOfComm " & _
"FROM TARA " & _
"WHERE (((TARA.check)=True AND TARA.Email = fOSUserName()))"
Debug.Print strSQL
Set rst = CurrentDb.OpenRecordset(strSQL)
strMessage = strMessage & "<font size=2><b>" & _
"<tr>" & _
"<td>" & " " & "</td>" & _
"<td>" & " " & "</td>" & _
"<td>" & " " & "</td>" & _
"<td>" & " " & "</td>" & _
"<td>Total</td>" & _
"<td align=right>" & Format(rst!SumOfGross, "currency") & "</td>" & _
"<td align=right>" & Format(rst!SumOfComm, "currency") & "</td>" & _
"<td align=right>" & Format(rst!SumOfGross - rst!SumOfComm,
"currency") & "</td>" & _
"</tr>"
rst.Close
Set rst = Nothing

' CLOSE THE TABLE
---------------------------------------------------------
strMessage = strMessage & strFntEnd & strTableEnd

' Create e-mail item
------------------------------------------------------
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
With objMail
'Set body format to HTML
..To = " "
..Subject = "Past Due Item"
..BodyFormat = olFormatHTML
..HTMLBody = "<HTML><BODY>" & strFntNormal & strMessage & " </BODY></
HTML>"
..Display
End With
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

In over my head with Automation error 6
How can I redirect to a URL? 0
Exporting Access Data into Email Body 1
Not able to add default Signature 5
Sending a email in a continous form. 10
Exporting Access to Excel on Multiple Named extra sheets created 1
Exporting Logo from Access 97 to Excel 2000 by copy and pastespecial is stopping Cell A1 selection 3

Top