Option Explicit
Option Base 1 'Start Value for Array 1 or 0
Public RunReport(34) As Boolean 'Array Variable - Has Report been Selected True/False
Public ArrayReportName(34) As String 'Array Variable - Report Name
Public strDir As String 'Path for Reports (C Drive)
Public strFlenme As String 'Report Filename = Path Name + Sub Folder + Report Name
Public strNewPdfFlenme As String 'Pdf File Name
Public i As Integer 'Variable - Counting
Public strReportName As String 'Report Name
Public strEmailAddr As String 'Email Address
Public pathname As String 'Pathname of Attachment
'Automatically Loaded Userform - Requires Macro's to be enabled
'Runs to Following Code.....
Sub Run()
For i = 1 To 34
'Depending on which Reports are selected
If RunReport(i) = True Then
'Report Name = Arrayed Report Name
strReportName = ArrayReportName(i)
Else
GoTo stepover
End If
'Document / Report Path
strDir = "C:\Temp"
'Creates Filename using Path Name + Sub folder + Report Name + File Type
strFlenme = strDir & "\BO" & strReportName & ".rep"
'Filename for PDF Document
strNewPdfFlenme = strDir & "\PDF" & strReportName & ".pdf"
'Opens Report
Application.Documents.Open (strFlenme)
'Disables User Prompts – Defaults to last Refreshed value
'(i.e. you need to have run the report at least once manually!!)
Application.Interactive = False
'Refreshes Document
With ActiveDocument
.Refresh
End With
'Prints
ActiveReport.PrintOut
'Enables user prompts – Don’t want to lose this!!
Application.Interactive = True
'Saves Report as a PDF file - Handy for people who don't have Business Objects!!
ActiveDocument.ExportAsPDF (strNewPdfFlenme)
'Save
ActiveDocument.Save
'Closes
ActiveDocument.Close
stepover:
Next
MsgBox "All Reports Updated, Refresh and Printed", vbOKOnly
'Shows Another Userform - Select E-mail Parameters
'FrmPDFDistr.Show
End Sub
'From FrmPDFDistr......
'If TeamLeaders.value = true then 'Cmd Button Clicked on
'Stremailaddr = "Name@EmailAddress.co.uk"
'Else
'Stremailaddr = "Name2@EmailAddress.co.uk"
'End if
'Call Mailer
Sub Mailer()
'Mails without security alert
'Need reference to Outlook in the Project References
Dim objol As New Outlook.Application
Dim objmail As MailItem
Set objol = New Outlook.Application
Set objmail = objol.CreateItem(olMailItem)
With objmail
'Email To = Email Address in quotes
.To = strEmailAddr
'.cc = "whoever" 'enter in here the email address
'Subject
.Subject = ""
'Message Body
.Body = "Please find attached the Report PDF's." & _
vbCrLf & vbCrLf & "Spiel" & _
vbCrLf & "More Spiel" & _
vbCrLf & vbCrLf & "" & vbCrLf & _
vbCrLf & "Name" & vbCrLf & "Job Title"
'Does not Expire
.NoAging = True
'Read Receipt
.ReadReceiptRequested = True
pathname = strDir & "\PDF" & strReportName & ".pdf"
For i = 1 To 34
'Check if report is ok to attach
If RunReport(i) = True Then
'adds attachment to email
.Attachments.Add pathname
Else
End If
Next
.Display
End With
Set objmail = Nothing
Set objol = Nothing
End Sub