rdemyan via AccessMonster.com wrote:
Thanks, I've been doing a little research on it and it does look interesting
and promising. I'll try it out over the weekend and report back.
If you are going to use CDO and you are distributing your application
to dissimilar machines and system-setups, you may find it much less
troublesome to use late binding, than to set a reference to CDO.
This is the only late-binding thingme I can lay my hands on right now;
It has a lot of extraneous stuff. (It sends a report as one page of
html.)
Option Explicit
Public Sub SendReportAsHTML( _
ByVal ReportName As String, _
ByVal SMTPServer As String, _
ByVal SendUserName As String, _
ByVal SendPassword As String, _
ByVal SendEmailAddress As String, _
ByVal Subject As String, _
ByVal Recipients As String, _
Optional ByVal NumberofPagesAllowed As Long = 10)
Dim Buffer As String
Dim Position As Long
Dim FileNumber As Integer
Dim HTML As String
Dim HTMLFullPath As String
Dim iCfg As Object
Dim iMsg As Object
Dim Skelton As String
Dim TempDirectory As String
Dim Truncate As Long
Set iCfg = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
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, "</TABLE>")
While Position <0
Truncate = Position
Position = InStr(Truncate + 1, Buffer, "</TABLE>")
Wend
HTML = HTML & Left(Buffer, Truncate + 7)
HTML = HTML & "<hr>"
Kill HTMLFullPath
HTMLFullPath = Dir$()
NumberofPagesAllowed = NumberofPagesAllowed - 1
Wend
If Len(HTMLFullPath) <0 And NumberofPagesAllowed = 0 Then _
HTML = HTML & "<br><b>Partial Report: Additional Pages not Shown"
With iCfg.Fields
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
SMTPServer
..Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1
..Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
SendUserName
..Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
SendPassword
..Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress")
= SendEmailAddress
..Update
End With
With iMsg
..Configuration = iCfg
..Subject = Subject
..To = Recipients
..HTMLBody = HTML
..Send
End With
SendReportAsHTMLExit:
Close
Set iMsg = Nothing
Set iCfg = Nothing
Exit Sub
SendReportAsHTMLErr:
With Err
MsgBox .Description, vbCritical, "Error " & .Number
End With
Resume SendReportAsHTMLExit
End Sub