Dear all,
I'm trying to create a macro that will export the sheet to a PDF file using the Bullzip PDF printer. But for some unknown reason, QV keep crashing when I run the macro. It crashes during the printing, and it is random. (not tied to specific sheet)
Below is the macro code I'm using:
Sub PrintPDFReport
vPDFPath = ActiveDocument.GetVariable("vPDFPath").GetContent().String 'QV - Get the PDF save path from the QV variable.
vPrintSheet = "|" & ActiveDocument.GetVariable("vPrintSheet").GetContent().String & "|" 'QV - Get the sheets to print. separated using pipe.
vEmailFrom = ActiveDocument.GetVariable("vEmailFrom").GetContent().String 'QV - Get email from value from the variable.
vEmailTo = ActiveDocument.GetVariable("vEmailTo").GetContent().String 'QV - Get email to value from the variable.
vEmailSubject = ActiveDocument.GetVariable("vEmailSubject").GetContent().String 'QV - Get email subject value from the variable.
vEmailTextBody = ActiveDocument.GetVariable("vEmailTextBody").GetContent().String 'QV - Get email text body value from the variable.
vEmailAttachment = vPDFPath
vPageCount = 1 'QV - for merging the pages in PDF.
for i = 0 to ActiveDocument.NoOfSheets - 1 'Loop through all the sheets in the QVW
set obj = ActiveDocument.GetSheet(i) 'QV - Assign sheet to an object.
vSheetName = obj.GetProperties.Name 'QV - Get the sheet name and assign it to a variable.
If instr(vPrintSheet,"|" & vSheetName & "|") then 'QV - check if the current is in the "printable" list.
ActiveDocument.GetSheet(i).Activate 'QV - Activate the QV sheet.
ActiveDocument.GetApplication.WaitForIdle 'QV - wait for all QV objects loaded.
ActiveDocument.GetApplication.Sleep 1000
if vPageCount = 1 then
vMergeFlag = false 'If first page, don't merge.
else
vMergeFlag = true 'If not first page, then perform merge.
end if
Call PrintPDFWithBullZip(vPDFPath, vMergeFlag) 'Change the printer settings.
obj.Print true
ActiveDocument.GetApplication.Sleep 1000
vPageCount = vPageCount+1
end if
next
Call EmailReport(vEmailFrom, vEmailTo, vEmailSubject, vEmailTextBody, vEmailAttachment)
ActiveDocument.Save 'QV - Save the QVW.
Application.Quit 'QV - Quit the QlikView application.
End sub
'===========================================================================
'===========================================================================
FUNCTION PrintPDFWithBullZip (pdfOutputFile, mergeFlag)
set obj = CreateObject("Bullzip.PDFSettings")
obj.SetValue "Output" , pdfOutputFile
obj.SetValue "ConfirmOverwrite", "no"
obj.SetValue "ShowSaveAS", "never"
obj.SetValue "ShowSettings", "never"
obj.SetValue "ShowPDF", "no"
obj.SetValue "RememberLastFileName", "no"
obj.SetValue "RememberLastFolderName", "no"
obj.SetValue "ShowProgressFinished", "no"
obj.SetValue "ShowProgress", "no"
if mergeFlag = true then 'merge multiple pages into 1 file
obj.SetValue "mergefile", pdfOutputFile
end if
obj.WriteSettings True
END FUNCTION
'===========================================================================
'===========================================================================
FUNCTION EmailReport(emailFrom, emailTo, emailSubject, emailTextBody, emailAttachment)
vSMTPServer = ActiveDocument.GetVariable("vSMTPServer").GetContent().String 'QV - Get SMTP server address from the variable.
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
SMTPServer = vSMTPServer
Const SMTPPort = 25 ' Port number for SMTP
Const SMTPTimeout = 60 ' Timeout for SMTP in seconds
'Sending mail
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
objEmail.From = emailFrom 'Email Sender
'objEmail.To = emailTo 'Email Recipient
objEmail.Bcc = emailTo 'Email Recipient
objEmail.Subject = emailSubject ' Subject
objEmail.TextBody = emailTextBody 'Text Body
objEmail.AddAttachment emailAttachment ' Attachement
objEmail.Send
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
END FUNCTION
