sub Create_Report
tempFolder = "C:\Documents and Settings\bi\My Documents\"
Set SelectedReportID = ActiveDocument.Fields("reportID").GetPossibleValues
Set SelectedExportType = ActiveDocument.Fields("ExportTo").GetPossibleValues
Set SelectedExcelID = ActiveDocument.Fields("ExcelExportID").GetPossibleValues
Set SelectedReportName = ActiveDocument.Fields("reportName").GetPossibleValues
set selectedEmail_Subject = ActiveDocument.Fields("Email_Subject").GetPossibleValues
Set SelectedEmail_Body = ActiveDocument.Fields("Email_Body").GetPossibleValues
set selectedEmail_addr = ActiveDocument.Fields("Email_addr").GetPossibleValues
dim rpt_date_time
rpt_date_time =ActiveDocument.Evaluate("day(today(1)-1)") & ActiveDocument.Evaluate("month(today(1)-1)") & ActiveDocument.Evaluate("year(today(1)-1)") &"."& ActiveDocument.Evaluate("hour(now(1))") &"."& ActiveDocument.Evaluate("minute(now(1))") &"."& ActiveDocument.Evaluate("second(now(1))")
for i=0 to SelectedReportID.count-1
dim Email_Subject
dim Email_Body
dim Email_addr
Email_Subject=""
Email_Body=""
Email_addr=""
Email_Subject = selectedEmail_Subject.Item(i).Text
Email_Body = SelectedEmail_Body.Item(i).Text
Email_addr = selectedEmail_addr.Item(i).Text
If SelectedReportID.count > 0 Then
If SelectedExportType.Item(i).Text ="PDF" Then
reportID = SelectedReportID.Item(i).Text
set rep = ActiveDocument.GetReport(reportID)
reportName = rep.Name
reportFile = tempFolder & reportName & rpt_date_time & ".pdf"
'PRINTING THE PDF FILE
ActiveDocument.PrintdocReport reportID,"PDF-XChange 4.0", false
Set objFSO = CreateObject("Scripting.FileSystemObject")
err.number=1
do
if err.number = 0 then exit do
On Error Resume Next
err.clear
objFSO.MoveFile "C:\TEMP\QlikView Printing.pdf" , reportFile
loop
wirte_to_log_file rpt_date_time & " report " & reportFile & " finish ok"
Else
ExcelID = SelectedExcelID.Item(i).Text
reportFile = tempFolder & SelectedReportName.Item(i).Text & rpt_date_time
'PRINTING THE EXCEL FILE
set obj = ActiveDocument.GetSheetObject(ExcelID)
obj.ExportBiff reportFile & ".xls"
reportFile = reportFile & ".xls"
'wirte_to_log_file rpt_date_time & " report " & reportFile & " finish ok"
End if
'SEND THE MAIL with ATTACHMENT
sendMail reportFile,Email_Subject,Email_Body,Email_addr,rpt_date_time
End if
next
end sub
function sendMail(pdfFile,mail_Subject,mail_Body,mail_addr,rept_date_time)
Dim objEmail
Const cdoSendUsingPort = 2 ' Send the message using SMTP
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Const SMTPServer = "main.tourplus.local"
Const SMTPPort = 25 ' Port number for SMTP
Const SMTPTimeout = 60 ' Timeout for SMTP in seconds
'Sending mail
strMailattach = pdfFile
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.Fields
With objFlds
'---------------------------------------------------------------------
' SMTP server details
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = SMTPTimeout .Update
'---------------------------------------------------------------------
End With
'Add Subject
strSubject = mail_Subject
'getvariable("mailSubject")
if strSubject ="" then
strSubject = "QlikView Report"
End if
'Add the body
strMsg = mail_Body
if strMsg = "" then
strMsg = "Please find attached report. This is a System generated mail from QlikView"
End if
objEmail.To =mail_addr 'Email Recipient
objEmail.From = "QlikView@tourplus.co.il" 'Email Sender objEmail.Subject = strSubject ' Subject
objEmail.TextBody = strMsg 'Text Body
objEmail.AddAttachment strMailattach
objEmail.Send
' wirte_to_log_file rept_date_time &" mail with att report: " & reportFile & " send to: " & mail_addr
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
end function
