Albert would you mind if I copy and paste your reply in this thread to the
ReportToPDF Web page?
Sure, please do, but I would have cleaned it up a bit more if I knew that!
;-)
In fact, here is the full code listing.
Note that the first code snip is designed to be placed on a custom menu bar
(one that I use for ALL reports). The custom menu bar simply has a email as
pdf button on it. So, while looking at ANY report, you simply "click" on
the email button...
All that is needed is to place the name of the function in custom menu bars
on-action setting
eg:
=AskReportSend()
So, the code to "call" the pdf code from the reprot menu is:
Public Function AskReportSend()
' this is the email option included on every report
Dim rptActiveReport As Report
Dim strEmail As String
Dim strSubject As String
Dim strBodyText As String
Dim strDocName As String
strSubject = ""
strBodyText = ""
Set rptActiveReport = Screen.ActiveReport
strEmail = ""
strDocName = CurrentProject.path & "\" & rptActiveReport.Name & ".pdf"
Call EmailReport(rptActiveReport.Name, "For your information", "",
strDocName, "")
End Function
So, the above is used for all reports.
the code you just asked for follows:
Public Sub EmailReport(strReportName As String, _
strSubject As String, _
strMsgText As String, _
strDocName As String, _
strEmailTo As String)
' sends the active report out....
' send to user via email
Dim myreport As Report
Dim picturecount As Long
'Dim ol As Outlook.Application
Dim ol As Object ' Late binding 10/03/2001 - Ak
'Dim ns As NameSpace
Dim ns As Object ' Late bind
'Dim newmessage As MailItem
Dim newmessage As Object ' Late bind
Dim mymessage As String
'Dim objOutlookAttach As Outlook.Attachment
'Dim objOutlookAttach As Object
'Kill strDocName
MyPbar.ShowProgress
MyPbar.TextMsg = "Creating Report File"
MyPbar.Pmax = 4
' DoCmd.OpenReport strReportName, acViewPreview, , strWhere
' Reports(strReportName).Visible = False
'DoCmd.OutputTo acReport, strReportName, acFormatRTF, strDocName, False
Call ConvertReportToPDF(strReportName, , strDocName, False, False)
DoCmd.Close acReport, strReportName
' gene the doc...now start the email...
Dim MySql As String
On Error GoTo CreateOutLookApp
Set ol = GetObject(, "Outlook.Application")
On Error Resume Next
Set ns = ol.GetNamespace("MAPI")
ns.Logon
Set newmessage = ol.CreateItem(0) ' 0 = olMainItem
With newmessage
.Recipients.Add strEmailTo
.Subject = strSubject
.Body = strMsgText
'Set objOutlookAttach = .Attachments.Add(stDocName)
.Attachments.Add (strDocName)
MyPbar.IncOne
MyPbar.HideProgress
Set MyPbar = Nothing
.Display
' .Send
End With
MyPbar.HideProgress
Set MyPbar = Nothing
Exit Sub
CreateOutLookApp:
Set ol = CreateObject("Outlook.application")
Resume Next
End Sub
So, that about routine does not necessary need be called from a custom menu
(that is the job of the first code snip).
The only other tip I can offer is that a user can (and should) simply open
the report BEFORE calling the above routine if they want a particular
"where" clause, since your code will operate on the already opened (and more
importantly *filtered* report) if need be.
