|
Home > Archive > MS Access database support > April 2006 > Formatting Outlook text from Access VBA
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
| Author |
Formatting Outlook text from Access VBA
|
|
|
| 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
| |
|
|
| Lyle Fairfield 2006-04-05, 8:28 pm |
| 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(FileNumbe
r), 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, , adOpenStreamFromReco
rd
.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.
| |
| Ron2005 2006-04-06, 9:35 am |
| 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]!& #91;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
| |
| Ron2005 2006-04-06, 9:35 am |
| 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.
| |
|
|
|
|
|