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.