Macro Powerplay for running, saving and emailing report with outlook

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"