0 Replies Latest reply: May 2, 2018 1:22 PM by Felipe Mertens Brancher RSS

    Enviar relatorio por e-mail via macro.

    Felipe Mertens Brancher

      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