Some old code i found cleaning up.
' macro to run an Powerplay report
' save the reports in pdf format with the date appended to the report name
' create an email in Outlook with the pdf attached
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Option Explicit
Declare Sub SaveThePDF(cube$, ppr$, pdf$ )
Declare Sub Outlook(strSubject$, strTo$, strBody$, strAttachment$)
Dim objPPRep as Object
Dim objPPApp as Object
Dim objPDFPub as Object
Dim objOutlook as Object
Dim objOutlookEmail as Object
Dim objOutlookAttachments as Object
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
Dim strToday As String
Dim strReportName1 As String
Dim strCubeName1 As String
Dim strFileName1 As String
Dim strMailTo As String
Dim strSubject As String
Dim strBody As String
strToday = date$
strCubeName1 = "C:\Program Files\Cognos\cer3\samples\PowerPlay\Cubes and Reports\Great Outdoors Company.mdc"
strFileName1 = "C:\Program Files\Cognos\cer3\samples\PowerPlay\Cubes and Reports\Great Outdoors Company" & strToday & ".pdf"
strMailTo = "cogadmin@cogknowhow.com"
call SaveThePDF ( strCubeName1, strReportName1, strFileName1 )
' msgbox "Het pdf rapport is gegenereerd!"
strSubject = "All Country Sales Report"
strBody = "This is a generated email. If there are issues with this email please contact me." & Chr(13) & Chr(13) & "Martijn Christenhusz" & Chr(13) & "BI consultant" & Chr(13) & "0653476357" & Chr(13) & Chr(13)
call Outlook(strSubject, strMailTo, strBody, strFileName1)
' msgbox "Het email bericht is gegenereerd in Outlook!"
End Sub
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SaveThePDF(cube$, ppr$, pdf$)
Set objPPApp = CreateObject("Powerplay.Application")
Set objPPRep = CreateObject("CognosPowerPlay.Report")
' Set objPPRep = objPPApp.New (cube, -1)
objPPRep.New cube, -1
objPPRep.ExplorerMode = False
objPPRep.Visible = True
' strReportName = objPPRep.FullName
Set objPDFPub = objPPRep.PDFFile( pdf , True )
'Set PDF save options
With objPDFPub
.SaveEntireReport = True
.SaveAllCharts = True
.ChartTitleOnAllPages = True
.IncludeLegend = True
End With
objPDFPub.Save
objPPRep.Close
objPPApp.Quit
Set objPPRep = Nothing
Set objPDFPub = Nothing
End Sub
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Outlook(strSubject$, strTo$, strBody$, strAttachment$)
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookEmail = objOutlook.CreateItem(OlMailItem)
objOutlookEmail.Subject = strSubject
objOutlookEmail.Body = strBody
objOutlookEmail.To = strTo
Set objOutlookAttachments = objOutlookEmail.Attachments
objOutlookAttachments.Add strAttachment
objOutlookEmail.Save
objOutlookEmail.Send
' the following two options might be useful, but have been commented out for this example
'objOutlookEmail.Display
Set objOutlook = Nothing
Set objOutlookEmail = Nothing
Set objOutlookAttachments = Nothing
End Sub
'Note: This macro be written so that it sends it to various people by performing the following action.
'Change the strTo1 to include several email addresses:
'strTo1="fredsmith@a.com;fredsmith@b.com;fredsmith@c.com"