microsoft access wrote:
Is there a way to skip the format selection when e-mailing reports?
Maybe in the VB coding? I want them to always be sent in an HTML
format.
Any information is helpful. Thanks.
If you have Windows 2000 or later this sends a report in HTML. It has
been tested in Northwind. Some lines may have been split by news
clients; they will have to be put back together. I think this does not
use any modern functions from this century but I have not tested for
that.
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
Private Sub TestSendReportAsHTML()
SendReportasHTML "Products By Category", "smtp.domain.com",
"fi*******@domain.com", "password", "First Last
<fi*******@domain.com>", "Testing SendReportAsHTML",
"re*******@domain.com"
End Sub
