'========================= functions for printing PDF and sending mail ============================ sub sendReport tempFolder = "C:\" Set oReports = ActiveDocument.Fields("reportID").GetPossibleValues Dim arrReports() if oReports.Count > 0 then redim arrReports(oReports.Count) for i = 0 to oReports.Count -1 reportID = oReports.Item(i).Text set rep = ActiveDocument.GetReport(reportID) reportName = rep.Name reportFile = tempFolder & reportID & "_" & reportName & ".pdf" deleteReport (reportFile) 'Cleaning out any previous report arrReports(i) = reportFile ' Print report to PDF printReportPDF reportID, reportFile ' Check the file is printed, before trying to send it checkOutputFile(reportFile) next ' Send report sendMail arrReports else msgbox ("You must select at least one report") end if ' Delete the temporary reports for each item in arrReports deleteReport(item) next ' Don't forget to activate Save As again after print! call activateSaveAs() set fileTest = nothing end sub function deleteReport(rFile) set oFile = createObject("Scripting.FileSystemObject") currentStatus = oFile.FileExists(rFile) if currentStatus = true then oFile.DeleteFile(rFile) end if set oFile = Nothing end function function sendMail(reportFiles) Dim objEmail Dim strMailTo 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 = "smtp.accovia.com" Const SMTPPort = 25 ' Port number for SMTP Const SMTPTimeout = 60 ' Timeout for SMTP in seconds 'Get Selected values from field "mailto" Set objSelected = ActiveDocument.Fields("mailto").GetSelectedValues if objSelected.Count = 0 then ' Nothing Selected msgbox ("No e-mail recipient selected") exit function else 'Send mail Set objEmail = CreateObject("CDO.Message") Set objConf = objEmail.Configuration Set objFlds = objConf.Fields With objFlds '--------------------------------------------------------------------- ' SMTP server details .Item("schemas.microsoft.com/.../sendusing") = cdoSendUsingPort .Item("schemas.microsoft.com/.../smtpserver") = SMTPServer .Item("schemas.microsoft.com/.../smtpauthenticate") = cdoAnonymous .Item("schemas.microsoft.com/.../smtpserverport") = SMTPPort .Item("schemas.microsoft.com/.../smtpusessl") = False .Item("schemas.microsoft.com/.../smtpconnectiontimeout") = SMTPTimeout .Update '--------------------------------------------------------------------- End With For i = 0 to objSelected.Count-1 ' create mailTo list strMailTo = strMailTo & objSelected.item(i).Text & ";" next strMailTo = left(strMailTo,len(strMailTo)-1) ' remove the last ; in list objEmail.To = strMailTo objEmail.From = "Travel-Intelligence@accovia.com" objEmail.Subject = getVariable("mailSubject") objEmail.TextBody = getText("BodyTX") for each item in reportFiles ' Add selected reports to mail if item <>"" then objEmail.AddAttachment item end if next objEmail.Send Set objFlds = Nothing Set objConf = Nothing Set objEmail = Nothing end if msgbox ("Mail Sent") end function function sendMailTest() 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 = "smtp.accovia.com" 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("schemas.microsoft.com/.../sendusing") = cdoSendUsingPort .Item("schemas.microsoft.com/.../smtpserver") = SMTPServer .Item("schemas.microsoft.com/.../smtpauthenticate") = cdoAnonymous .Item("schemas.microsoft.com/.../smtpserverport") = SMTPPort .Item("schemas.microsoft.com/.../smtpusessl") = False .Item("schemas.microsoft.com/.../smtpconnectiontimeout") = SMTPTimeout .Update '--------------------------------------------------------------------- End With objEmail.To = "philippe_motillon@videotron.ca" objEmail.From = "philippe@accovia.com" objEmail.Subject = "test" objEmail.TextBody = "message de test" objEmail.Send Set objFlds = Nothing Set objConf = Nothing Set objEmail = Nothing msgbox ("Test Mail Sent") end function function printReportPDF(oReport, pdfOutputFile) Set WSHShell = CreateObject("WScript.Shell") WSHShell.RegWrite "HKCU\Software\QlikViewPDF\OutputFile", pdfOutputFile, "REG_SZ" WSHShell.RegWrite "HKCU\Software\QlikViewPDF\BypassSaveAs", "1", "REG_SZ" 'QV Print ActiveDocument.PrintReport oReport, "QlikViewPDF", false set WSHShell = nothing end function function activateSaveAs() Set WSHShell = CreateObject("WScript.Shell") WSHShell.RegWrite "HKCU\Software\QlikViewPDF\OutputFile", "", "REG_SZ" WSHShell.RegWrite "HKCU\Software\QlikViewPDF\BypassSaveAs", "0", "REG_SZ" set WSHShell = nothing end function function checkOutputFile(pdfFile) Set fileTest = CreateObject("Scripting.FileSystemObject") currentStatus = fileTest.FileExists (pdfFile) if currentStatus = false then rem ** let QV sleep for 1 seconds ** ActiveDocument.GetApplication.Sleep 1000 checkOutputFile(pdfFile) end if set fileTest = nothing end function '==================== functions to get the reports in the document ============== function countReports set ri = ActiveDocument.GetDocReportInfo countReports = ri.Count end function function getReportInfo (i) set ri = ActiveDocument.GetDocReportInfo set r = ri.Item(i) getReportInfo = r.Id & "," & r.Name & "," & r.PageCount & CHR(10) end function '===================== Function to get the subject etc from variables in document ======== function getVariable(varName) set v = ActiveDocument.Variables(varName) getVariable = v.GetContent.String end function '===================== Function to get the body etc from texobjects in document ======== function getText(obj) set mytext = ActiveDocument.GetSheetObject(obj) prop = mytext.GetProperties getText = prop.Layout.Text.v end function