Formatting Outlook text from Access VBA

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Wayne - 24 Mar 2006 01:49 GMT

My supervisor performs the following steps to generate an email
notifying recipients of new problem reports:

1) Generate an Access report containing the columnar data and export it
to a .rtf file.
2) Using Word, convert the columnar data in the .rtf file to table.
3) Copy the table from Word and paste it in a new Outlook email
(default format is RTF).

I created a command button in the Access application which opens a new
Outlook mail message and successfully populates the To, Subject, and
Body. However, since the default font is Arial, the columns (separated
by tabs) do not line up.

I also tried using SendObject, but he doesn't want the recipients to
have to open an attachment.

Is there a way to have the VBA modify the font (to Courier) and tab
locations in the current mail item like you can with a Word object?
Does anyone have a better idea?

Appreciate any help,
Wayne

Reply to this Message

Ron2005 - 05 Apr 2006 20:49 GMT

You might look at this reference.

It may give you some ideas and you can go from there.

http://support.microsoft.com/default.aspx/kb/230915/en-us?

Reply to this Message

Lyle Fairfield - 05 Apr 2006 21:02 GMT

I have another idea. Is it better? Probably not.
1. I think it's nuts to send out a report by e-mail. Send out alink and
let the person click on the link and see the report at his or her
leisure. He or she doesn't have to send anything byt the link to other
people so that they can see the report. And there may be time saved in
not having to upload the report more than nce, although that may not be
true.

How to do? Some code. If you want courier modify the code to have any
style you want.

This is run in Northwind.mdb.

Public Sub UploadReportAsHTML( _
ByVal ReportName As String, _
ByVal Server As String, _
Optional ByVal UserName As String, _
Optional ByVal PassWord As String, _
Optional ByVal NumberofPagesAllowed As Long = 10)

Dim Buffer As String
Dim Position As Long
Dim FileNumber As Integer
Dim Heading As String
Dim HTML As String
Dim HTMLFullPath As String
Dim Skelton As String
Dim TempDirectory As String
Dim Truncate As Long

TempDirectory = Environ$("temp")
If Len(TempDirectory) = 0 Then TempDirectory = CurDir$()
TempDirectory = TempDirectory & "\"
Skelton = Format(Now(), "mmmddyyyyhhnnss")
HTMLFullPath = TempDirectory & Skelton & ".html"

DoCmd.OutputTo acOutputReport, ReportName, acFormatHTML, HTMLFullPath

HTMLFullPath = Dir$(TempDirectory & Skelton & "*.html")
While Len(HTMLFullPath) <> 0 And NumberofPagesAllowed <> 0
HTMLFullPath = TempDirectory & HTMLFullPath
FileNumber = FreeFile()
Open HTMLFullPath For Binary As #FileNumber
Buffer = String(LOF(FileNumber), vbNullChar)
Get #FileNumber, , Buffer
Close #FileNumber
Position = InStr(Buffer, "<BODY>") + 6
If Len(Heading) = 0 Then
Heading = Left(Buffer, Position)
Else
Buffer = Mid$(Buffer, Position + 1)
End If
Position = InStr(Buffer, "</TABLE>")
While Position <> 0
Truncate = Position
Position = InStr(Truncate + 1, Buffer, "</TABLE>")
Wend
HTML = HTML & Left(Buffer, Truncate + 7)
HTML = HTML & vbNewLine & "<HR>"
HTMLFullPath = Dir$()
NumberofPagesAllowed = NumberofPagesAllowed - 1
Wend

If Len(HTMLFullPath) <> 0 And NumberofPagesAllowed = 0 Then _
HTML = HTML & vbNewLine & "<P style=FONT-WEIGHT:700>" _
& vbNewLine _
& "Partial Report: Additional Pages not Shown" _
& vbNewLine _
& "<P>"
On Error Resume Next
Kill HTMLFullPath
On Error GoTo 0
HTMLFullPath = Dir$(TempDirectory & Skelton & "*.html")

HTML = HTML & vbNewLine & "</BODY>" & vbNewLine & "</HTML>"
FileNumber = FreeFile
Open HTMLFullPath For Binary As #FileNumber
Put #FileNumber, , HTML
Close #FileNumber

UploadFile HTMLFullPath, Replace(ReportName, " ", "") & ".html",
Server, UserName, PassWord

SendReportAsHTMLExit:
Close
Exit Sub

SendReportAsHTMLErr:
With Err
MsgBox .Description, vbCritical, "Error " & .Number
End With
Resume SendReportAsHTMLExit

End Sub

Public Sub UploadFile( _
ByVal FromPath As String, _
ByVal ToFile As String, _
ByVal Server As String, _
Optional ByVal UserName As String, _
Optional ByVal PassWord As String)

Dim r As ADODB.Record
Dim s As ADODB.Stream
Set r = New ADODB.Record
Set s = New ADODB.Stream

r.Open Server & "/" & ToFile, , adModeWrite, adCreateOverwrite, ,
UserName, PassWord

With s
.Open r, , adOpenStreamFromRecord
.Type = adTypeBinary
.LoadFromFile FromPath
.Close
End With

r.Close

End Sub

Private Sub test()
UploadReportAsHTML "Products By Category", "http://www.ffdba.com"
End Sub

The result can be seen at http://ffdba.com/productsbycategory.html

Yeah I know ... it doesn't work ... oh well ... it works here and
that's good enough for me. BTW ... the web server needs to be a
microsofty web server.

Reply to this Message

Ron2005 - 06 Apr 2006 14:33 GMT

here is some code relative to tabelizing an email in a HTML format.
This may give you an idea as to how to format the data into a table
then you would not have to worry about the font.
You will have to brush up on your html coding though.

The key to it all is the bodyformat and the htmlbody part.

=========================================
Set o = CreateObject("Outlook.Application")
'Set o = CreateObject("Word.Application")
Set m = o.CreateItem(0)

m.To = Forms![HiddenKey]![HManagerEmail]
If Not IsNull(Forms![HiddenKey]![HCopyEmail]) Then
m.CC = Forms![HiddenKey]![HCopyEmail]
End If
m.Subject = "Defect Analysis for " & Forms![HiddenKey]![HCompany] &
" - SR: " & Forms![HiddenKey]![HSr]
m.bodyformat = 2
m.htmlbody = Chr(13) & Chr(13) & _
"<body><Table><tr><td><b> Date: </b></td><td>" & Date &
"</td></tr>" & _
"<tr><td><b>Manager: </b></td><td>" &
Forms![HiddenKey]![HManager] & "</td></tr>" & _
"<tr><td><b>Name: </b></td><td>" &
Forms![HiddenKey]![HCompany] & "</td></tr>" & _
"<tr><td><b>PCS ID #:</b></td><td>" &
Forms![HiddenKey]![HSr] & "</td></tr>" & _
"<tr><td><b>Site ID: </b></td><td>" &
Forms![HiddenKey]![HSiteID] & "</td></tr>" & _
"<tr><td><b>SDD: </b></td><td>" &
Forms![HiddenKey]![HSDD] & "</td></tr>" & _
"<tr><td><b>Inv Dte: </b></td><td>" &
Forms![HiddenKey]![HInvoiceDate] & "</td></tr>" & _
"<tr><td><b>Inv #: </b></td><td>" &
Forms![HiddenKey]![HInvoice] & "</td></tr>" & _
"<tr><td><b>Defect #: </b></td><td>" &
Forms![HiddenKey]![HDefect] & "</td></tr>" & _
"<tr><td><b>IDMS #: </b></td><td>" &
Forms![HiddenKey]![HIDMS] & "</td></tr>" & _
"<tr><td><b>Reason: </b></td><td>" &
Forms![HiddenKey]![Hreasonfordefect] & "</td></tr>" & _
"<tr><td></td><td></td></tr>" & _
"<tr><td></td><td></td></tr>" & _
"</Table></body>"

' m.send ' to send it instead of displaying it.
m.Display
=================================================

Ron

Reply to this Message

Ron2005 - 06 Apr 2006 14:38 GMT

actually you could format then bounce through the file you were going
to send and stick each of the fields between the <td> and </td> entries
( these are the cell definitions for each row.

Sort of like this

<Table> 'start table
<tr> 'Start row
<td> </td> ' start and then stop a cell within a row.
<td> </td> ' start and then stop a cell within a row.
<td> </td> ' start and then stop a cell within a row.
</tr> ' end the row definition
<tr> 'Start row
<td> </td> ' start and then stop a cell within a row.
<td> </td> ' start and then stop a cell within a row.
<td> </td> ' start and then stop a cell within a row.
</tr> ' end the row definition
</table> ' end the table definition.

Reply to this Message

Ron2005 - 06 Apr 2006 20:26 GMT

One more addition:

The following link is to a HTML reference page that covers the above
and a whole lot more.

http://www.html-reference.com/

The in there you will also find perhaps another alternative to the
table thought. It is an html
reference to text format <tt>

http://www.html-helper.net/tutorial003.htm

and also

http://www.html-reference.com/TT.htm

Hope all of this has given you some ideas.

Ron

Reply to this Message

Wayne - 12 Apr 2006 22:12 GMT

Lyle,
Thanks for the help. Unfortunately, I don't believe the link would
be acceptable for a few reasons, including the fact that the
'enhancement' would increase the steps recipients must currently
perform in order to access the data. These reports generally contain
less than 10 lines so sending the text as an email is preferred.

Ron,
Thanks for your help as well. I was able to get this running at work
today using much of your example, however, 'bodyformat = 2' was not
known by the object. We're using Office 2000, so I'm not sure if
that makes a difference. Either way, it doesn't appear that I needed
it.

I created a condensed version here at home using Office XP (Access
2002) and provide the code below in case anyone is interested:

Dim strSQL, strHeader, strText As String
Dim dbs As Database, rst As DAO.Recordset
Dim olkApp As Outlook.Application
Dim objMailItem As Outlook.MailItem

strText = ""

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM tblNewPraers_Temp")

'The make table query below gets all records from tblNewPraers
matching
'user-specified dates and puts them in tblNewPraers_Temp
DoCmd.OpenQuery ("qryNewPraers")

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tblNewPraers_Temp")

If (rst.BOF = True And rst.EOF = True) Then
MsgBox ("No new PRAERs between " & Me.StartDate & " and " &
Me.EndDate)
GoTo Exit_cmdGenNewPraerEmail_Click
Else
rst.MoveFirst
End If

Set olkApp = New Outlook.Application
Set objMailItem = olkApp.CreateItem(olMailItem)

objMailItem.Recipients.Add "NewPraerGroup"
objMailItem.Recipients.ResolveAll
objMailItem.Subject = "New PRAERS - " & Now()

'Email header
strHead = "<Body>" _
& "<Font Face=Arial Size=2>" _
& "The following PRAERs are today's arrivals:" _
& "<p></p>" _
& "<Table Border>" _
& "<tr>" _
& "<td><Font Size=2><b>PRAER</td>" _
& "<td><Font Size=2><b>SYSTEM</td>" _
& "<td><Font Size=2><b>TITLE</td>" _
& "</tr>"

While Not rst.EOF
'Add each entry to the body
strText = strText _
& "<tr>" _
& "<td><Font Size=2>" & rst!PRAER & "</td>" _
& "<td><Font Size=2>" & rst!System & "</td>" _
& "<td><Font Size=2>" & rst!Title & "</td>" _
& "</tr>"
rst.MoveNext
Wend

'Add end of the body
strText = strText & "</Table></Body></Font>"

objMailItem.HTMLBody = strHead & strText
objMailItem.Display

Set olkApp = Nothing
Set objMailItem = Nothing
DoCmd.SetWarnings True

Reply to this Message

Ron2005 - 12 Apr 2006 23:04 GMT

Looks great. I am glad it worked.

We are using Outlook 2003 so bodyformat may not be relavent to the
earlier version.

Ron

Reply to this Message

FMS Development Team - 17 Apr 2006 18:40 GMT

Hi Wayne,

Our new Total Access Emailer product addresses your need directly.
Rather than sending a report to RTF, it will let you directly use
filtered reports in HTML format as your email message.

Visit our web site for a FREE preview of Total Access Emailer 2003,
version 11.5. It will also let you embed data from tables and queries
in your message or as attachments.

Luke Chung
President
FMS, Inc.
http://www.fmsinc.com

Reply to this Message