1 Reply Latest reply: Dec 29, 2015 11:35 AM by Agnaldo Neves RSS

    Enviar 02 pdf anexo no email

    Agnaldo Neves

      Tenho esta macro que está funcionando bem,

      Mas apareceu outro relatório para enviar junto.

      Seria

       

      Só que fazendo assim. Não funciona. Como seria o Código correto.

      Para enviar dois pdf no mesmo email. RP01 E RP02

       

      A linha do código que trata e está. abaixo.

      ActiveDocument.PrintDocReport "RP01", "Gerente"

       

       

      sub PrintReport

        Set WSHShell = CreateObject("WScript.Shell")

        fln = "S:\BI\TecnoFlex\PDF\myreport.pdf"

        RegKey = "HKEY_CURRENT_USER\Software\QlikViewPDF\"

        WSHShell.RegWrite RegKey & "BypassSaveAs", 1

        WSHShell.RegWrite RegKey & "OutputFile", fln

        ActiveDocument.GetApplication.Sleep 2000

        WSHShell.RegWrite RegKey & "BypassSaveAs", 0

        WSHShell.RegWrite RegKey & "OutputFile", ""

        

        Set WSHShell = nothing

      end sub

       

       

      function GetVariable(varName)

              Dim v

              set v = ActiveDocument.Variables(varName)

              GetVariable = v.GetContent.String

      end function

       

       

      Sub ExecMacro()

              'ActiveDocument.Reload       

              Envio()

              'ActiveDocument.Save

              'ActiveDocument.GetApplication.Quit

              'ActiveDocument.GetApplication.Close       

      End Sub

       

       

      Sub Envio()

        Set TabelaEmails = ActiveDocument.Fields("Gerente").GetPossibleValues(1000)

        For contEmail = 0 to TabelaEmails.Count - 1

        ActiveDocument.Fields("Gerente").Select TabelaEmails.Item(contEmail).Text

              ActiveDocument.PrintDocReport "RP01", "Gerente"

        PrintReport()

        ActiveDocument.GetApplication.Sleep 2000

        Set filesys = Nothing

              Set filesys = CreateObject("Scripting.FileSystemObject")

        If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf") then

        filesys.DeleteFile "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"

        End If

        ActiveDocument.GetApplication.Sleep 1000

        Set filesys = Nothing

            

        Set filesys = CreateObject("Scripting.FileSystemObject")

        If filesys.FileExists("C:\tmp\QlikView Printing.pdf") then

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"

        End If

        ActiveDocument.GetApplication.Sleep 1000

       

       

        vRepositorio  = GetVariable("vRepositorio")

        Porta         = GetVariable("smtpPorta")

        Server        = GetVariable("smtpServer")

        Usuario       = GetVariable("smtpUser")

        Senha         = GetVariable("smtpPWD")

        Origem        = GetVariable("smtpOrigem")

       

        Set objEmail = CreateObject("CDO.Message")

        Set objConf = objEmail.Configuration

        Set objFlds = objConf.Fields

       

        With objFlds

        '---------------------------------------------------------------------

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

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

        if len(Usuario) > 0 then

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

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

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

        else

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

        end if

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Porta

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

        .Update

        '---------------------------------------------------------------------

        End With

        Destinatarios     = TabelaEmails.Item(contEmail).Text

        'Destinatarios     = "teste@teste.ind.br"

        objEmail.To       = Destinatarios

        'objEmail.CC       = "nn@mm.com.br"

        objEmail.From     = "mmmm@nnnn.com.br"

        objEmail.Subject  = "Gerencia : " & TabelaEmails.Item(contEmail).Text

        objEmail.HTMLBody = ""

        objEmail.AddAttachment "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"

        objEmail.Send

       

              Set filesys = CreateObject("Scripting.FileSystemObject")

        If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf") then

        filesys.DeleteFile "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"

        End If

        ActiveDocument.GetApplication.Sleep 2000

        Set filesys = Nothing

        Next

        ActiveDocument.Fields("Gerente").Clear ' Limpar Filtro por Email

      End Sub