15 Replies Latest reply: Jul 19, 2016 9:30 AM by Agnaldo Neves RSS

    Corrigir ou melhorar codigo macro email

    Agnaldo Neves

      O Código abaixo está funcionando.

      Ele geras o pdf corretamente, Mas só gerar o email: "RP01" ,"Gerente"

      Como faço para gerar também para o "RP02", "Gerente2"

       

      Onde está errado a linha de código.

       

       

      Alguma dica...

       

       

      Estou tentando enviar dois anexo RP01 - Gerente  - athenas1200@gmail.com

                                                       RP02 - Gerente2 - contato@consultoriasoft.com.br

       

      Lendo os email:

      *************************************************************************************************************************

      LOAD * INLINE [

          Gerente

          athenas1200@gmail.com

       

      ];

       

       

      LOAD * INLINE [

          Gerente2

          contato@consultoriasoft.com.br

      ];

       

      *******************************************************************************************************************************

      Codigo do Macro:

      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

       

       

       

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

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

              ActiveDocument.PrintDocReport "RP02", "Gerente2"

       

        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     = "teste@contalsoft.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","Gerente2").Clear ' Limpar Filtro por Email

      End Sub