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:
Expand|Select|Wrap|Line Numbers
- 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