Qlik Community

Qlik Brasil

Group community for Brazil users. discussion only in Portuguese.

Highlighted
fmbrancher
Contributor

Enviar relatorio por e-mail via macro.

Bom tarde amigos.
Estou com uma dificuldade ao rodar uma macro para envio de e-mails.
Copiei ela de uma outra visão do qlik que roda normalmente mas na nova visão não está funcionando.

Eu rodo ela via agendador do WINDOWS. Porem ela só carrega mas não envia.
Estranho que se eu entro na macro no QLIK e dou um testar o arquivo é enviado normalmente.

Além disso quando rodo pela segunda vez (manualmente), ele não substitui o arquivo pdf já existente.


Alguem sabe oque pode estar acontecendo?

A macro segue abaixo

'====================================================================

'E-mail Gerencial - Confecção

'====================================================================

Sub MacroMail

  set var1    = ActiveDocument.Variables("vMacro")

  sExecutar  = var1.GetContent.String

  if sExecutar = "1" then

    var1.SetContent "0" , true

    EnviarEmailPanorama 'email

    ActiveDocument.GetApplication.WaitForIdle

  end if

End Sub

'====================================================================

'E-mail Gerencial - Confecção

'====================================================================

Sub EnviarEmailPanorama

  on error resume next

  ActiveDocument.ClearAll true 'limpar seleção

  vReport = "RP01" 'Set report

  vName = "Panorama" 'Name of output pdf

  ActiveDocument.PrintReport(vReport), "Bullzip PDF Printer", false  'Printreport

  reportFile = "c:\PDFs\Operations\" & vName &".pdf" 'Setting outputname

  MyPrintPDFWithBullZip(reportFile) 'Call pdf printer

  ActiveDocument.GetApplication.WaitForIdle

  'monta o assunto do email

  set var1    = ActiveDocument.Variables("vTituloEmail1")

  sSubject    = var1.GetContent.String

  set var1      = ActiveDocument.Variables("vListaEmailPanorama")

  sDestinatario = var1.GetContent.String

  'sDestinatario = "xxx@yyyyyy.com.br"

  call SendMail(reportFile, sDestinatario, sSubject, "Bom dia. Relatório em anexo.")

End sub

'====================================================================

'Enviar email com anexo

'====================================================================

FUNCTION SendMail (pdfOutputFile, sDestino, sAssunto, sCorpo)

Dim objEmail

Const cdoSendUsingPort = 2 ' Send the message using SMTP

Const cdoBasicAuth = 1 ' Clear-text authentication

Const cdoTimeout = 60 ' Timeout for SMTP in seconds

mailServer = "outlook.yyyy.com.br"

SMTPport = 25

mailusername = "yyyy\mailsite"

mailpassword = "Ms_159753"

mailto = sDestino

mailSubject = sAssunto

mailBody = sCorpo

Set objEmail = CreateObject("CDO.Message")

Set objConf = objEmail.Configuration

Set objFlds = objConf.Fields

With objFlds

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer

.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") = cdoTimeout

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword

.Update

End With

objEmail.To = mailto

objEmail.From = "mailsite@yyyyycom.br"

objEmail.Subject = mailSubject

objEmail.TextBody = mailBody

objEmail.AddAttachment pdfOutputFile

objEmail.Send

Set objFlds = Nothing

Set objConf = Nothing

Set objEmail = Nothing

END FUNCTION

'====================================================================

'imprimir para pdf

'====================================================================

FUNCTION MyPrintPDFWithBullZip (pdfOutputFile)

  'set obj = CreateObject("Bullzip.PDFPrinterSettings")

  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"

  obj.WriteSettings True

END FUNCTION

Function fLog (pLog)

Const ForAppending = 8

Set objFSO = CreateObject ("Scripting.FileSystemObject")

Set objTextFile = objFSO.OpenTextFile _

    ("C:\TestServerSide.txt", ForAppending, True) 'Create a file on disk c:\ in where you are running (client or server)

    objTextFile.WriteLine (pLog) 'We add text to the file

objTextFile.Close 'We closed the and save the file

End Function

sub Trigger

  Set conn = CreateObject("ADODB.Connection")

  Set rs = CreateObject("ADODB.Recordset")

  ' String connection

  strConn = "Provider=MSDAORA;User ID=xxxx;Password=xxxxxx;Data Source=ORACLE2;OLEDB.NET=true;SPPrmsLOB=true;Persist Security Info=False;"

  ' Open the connection

  conn.Open strConn

  parameter1= date1

  parameter2= date2

  ' Execute the stored procedure

  sqlQuery = "call pUpdate('update solicitacao_interna set descricao = descricao||descricao where numreg = 334826411')"

  rs.Open sqlQuery, conn, adOpenForwardOnly

end sub

Tags (1)