Sending an Email in Qlikview

'========================= 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 = "[e-mail]"

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 = "[e-mail]"

objEmail.From = "[e-mail]"

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