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 SendReportasHTM L( _
ByVal ReportName As String, _
ByVal SMTPServer As String, _
ByVal SendUserName As String, _
ByVal SendPassword As String, _
ByVal SendEmailAddres s As String, _
ByVal Subject As String, _
ByVal Recipients As String, _
Optional ByVal NumberofPagesAl lowed 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("C DO.Configuratio n")
Set iMsg = CreateObject("C DO.Message")
TempDirectory = Environ$("temp" )
If Len(TempDirecto ry) = 0 Then TempDirectory = CurDir$()
TempDirectory = TempDirectory & "\"
Skelton = Format(Now(), "mmmddyyyyhhnns s")
HTMLFullPath = TempDirectory & Skelton & ".html"
DoCmd.OutputTo acOutputReport, ReportName, acFormatHTML, HTMLFullPath
HTMLFullPath = Dir$(TempDirect ory & Skelton & "*.html")
While Len(HTMLFullPat h) <0 And NumberofPagesAl lowed <0
HTMLFullPath = TempDirectory & HTMLFullPath
FileNumber = FreeFile()
Open HTMLFullPath For Binary As #FileNumber
Buffer = String(LOF(File Number), 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$()
NumberofPagesAl lowed = NumberofPagesAl lowed - 1
Wend
If Len(HTMLFullPat h) <0 And NumberofPagesAl lowed = 0 Then _
HTML = HTML & "<br><b>Par tial Report: Additional Pages not Shown"
With iCfg.Fields
..Item("http://schemas.microso ft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microso ft.com/cdo/configuration/smtpserverport" )
= 25
..Item("http://schemas.microso ft.com/cdo/configuration/smtpserver") =
SMTPServer
..Item("http://schemas.microso ft.com/cdo/configuration/smtpauthenticat e")
= 1
..Item("http://schemas.microso ft.com/cdo/configuration/sendusername") =
SendUserName
..Item("http://schemas.microso ft.com/cdo/configuration/sendpassword") =
SendPassword
..Item("http://schemas.microso ft.com/cdo/configuration/sendemailaddres s")
= SendEmailAddres s
..Update
End With
With iMsg
..Configuration = iCfg
..Subject = Subject
..To = Recipients
..HTMLBody = HTML
..Send
End With
SendReportAsHTM LExit:
Close
Set iMsg = Nothing
Set iCfg = Nothing
Exit Sub
SendReportAsHTM LErr:
With Err
MsgBox .Description, vbCritical, "Error " & .Number
End With
Resume SendReportAsHTM LExit
End Sub
Private Sub TestSendReportA sHTML()
SendReportasHTM L "Products By Category", "smtp.domain.co m",
"fi*******@doma in.com", "password", "First Last
<fi*******@doma in.com>", "Testing SendReportAsHTM L",
"re*******@doma in.com"
End Sub
