1 Reply Latest reply: May 11, 2016 10:52 AM by Eduardo Endo RSS

    email pdf (enviar por Relatório para cada usúario)

    agnaldo neves

      Tenho este script que funciona bem. a Bastante tempo.

      Foi contribuição aqui do fórum.

       

      - Existe como eu enviar (Exemplo)

      RP01", "RP01  para destinatario de email   x@x.com.br

      RP02", "RP02  para destinatario de email   y@y.com.br

       

      no macro abaixo:

       

      Alguém tem alguma dica?

       

      Hoje é enviado para todos ao mesmo tempo. E seria melhor enviar relatório individual

       

       

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

       

      sub PrintReport

        Set WSHShell = CreateObject("WScript.Shell")

        fln = "C:\tmp\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  ' Aqui faz um Laco com o campo "Gerente"......

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

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

              'Aqui apaga se tiver os arquivos.....

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

        filesys.DeleteFile "C:\tmp\Relatorio1.pdf"

        End If

        Set filesys = Nothing

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

        filesys.DeleteFile "C:\tmp\Relatorio2.pdf"

        End If

        Set filesys = Nothing

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

        filesys.DeleteFile "C:\tmp\Geral.pdf"

        End If

        Set filesys = Nothing

              Set filesys = CreateObject("Scripting.FileSystemObject")

        If filesys.FileExists("C:\tmp\Tiradentes-82.pdf") then

        filesys.DeleteFile "C:\tmp\Tiradentes-82.pdf"

        End If

        Set filesys = Nothing

              Set filesys = CreateObject("Scripting.FileSystemObject")

        If filesys.FileExists("C:\tmp\Brasil-282.pdf") then

        filesys.DeleteFile "C:\tmp\Brasil-282.pdf"

        End If

        Set filesys = Nothing

              Set filesys = CreateObject("Scripting.FileSystemObject")

        If filesys.FileExists("C:\tmp\Ramalho-182.pdf") then

        filesys.DeleteFile "C:\tmp\Ramalho-182.pdf"

        End If

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

              ' Aqui roda o relatorio ID   RP01

        ActiveDocument.GetApplication.Sleep 2000

        Set filesys = Nothing

              ActiveDocument.PrintDocReport "RP01", "RP01" 

        PrintReport()

        ActiveDocument.GetApplication.Sleep 3000

        ' Aqui se existe o PDF, entao renomeia ele.......

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Relatorio1.pdf"

        End If

        Set filesys = Nothing

        ActiveDocument.GetApplication.Sleep 3000

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

              ' Aqui roda o relatorio ID   RP02

              ActiveDocument.PrintDocReport "RP02", "RP02" 

        PrintReport()

        ActiveDocument.GetApplication.Sleep 3000

        ' Aqui se existe o PDF, entao renomeia ele.......

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Relatorio2.pdf"

        End If

        Set filesys = Nothing

        ActiveDocument.GetApplication.Sleep 3000

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

              ' Aqui roda o relatorio ID   RP03

              ActiveDocument.PrintDocReport "RP03", "RP03" 

        PrintReport()

        ActiveDocument.GetApplication.Sleep 3000

        ' Aqui se existe o PDF, entao renomeia ele.......

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Geral.pdf"

        End If

        Set filesys = Nothing

        ActiveDocument.GetApplication.Sleep 3000

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

        ' Aqui roda o relatorio ID   RP04

              ActiveDocument.PrintDocReport "RP04", "RP04" 

        PrintReport()

        ActiveDocument.GetApplication.Sleep 3000

        ' Aqui se existe o PDF, entao renomeia ele.......

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Tiradentes-82.pdf"

        End If

        Set filesys = Nothing

        ActiveDocument.GetApplication.Sleep 3000

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

      ' Aqui roda o relatorio ID   RP04

              ActiveDocument.PrintDocReport "RP05", "RP05" 

        PrintReport()

        ActiveDocument.GetApplication.Sleep 3000

        ' Aqui se existe o PDF, entao renomeia ele.......

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Brasil-282.pdf"

        End If

        Set filesys = Nothing

        ActiveDocument.GetApplication.Sleep 3000

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

        ' Aqui roda o relatorio ID   RP04

              ActiveDocument.PrintDocReport "RP06", "RP06" 

        PrintReport()

        ActiveDocument.GetApplication.Sleep 3000

        ' Aqui se existe o PDF, entao renomeia ele.......

              Set filesys = CreateObject("Scripting.FileSystemObject")

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

          filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Ramalho-182.pdf"

        End If

        Set filesys = Nothing

        ActiveDocument.GetApplication.Sleep 3000

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

      '        ' Inicio das configuracoes do EMAIL

        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") = True

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

        .Update

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

        End With

        'Destinatarios     = TabelaEmails.Item(contEmail).Text

        Destinatarios     = "xxxxcardim@gmail.com"

        'Destinatarios     = "xxxxxxxx@gmail.com"

        objEmail.To       = Destinatarios

        objEmail.CC       = "xxxxxxx@gmail.com"

        objEmail.From     = "xxxxx@gmail.com"

        objEmail.Subject  = "teste."

        objEmail.HTMLBody = "teste."

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

              'Aqui colocamos os anexos.....

        objEmail.AddAttachment "C:\tmp\Relatorio1.pdf"

        objEmail.AddAttachment "C:\tmp\Relatorio2.pdf"

        objEmail.AddAttachment "C:\tmp\Geral.pdf"

        objEmail.AddAttachment "C:\tmp\Tiradentes-82.pdf"

            objEmail.AddAttachment "C:\tmp\Brasil-282.pdf"

            objEmail.AddAttachment "C:\tmp\Ramalho-182.pdf"

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

        objEmail.Send

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

              'Aqui apagamos os arquivos pois senao da erro na proxima vez.....

        'ActiveDocument.Save

        ActiveDocument.GetApplication.Sleep 3000

            

        'Next

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

       

       

       

       

      End Sub

        • Re: email pdf (enviar por Relatório para cada usúario)
          Eduardo Endo

          salva em algum inline todos e-mails dos destinatários, na parte de adicionar para quem vai o e-mail, coloca um FOR passando por cada um deles e enviando.

           

          Acho que ficaria +- assim:

           

          FOR i = 0 TO UBOUND(dir)

          ActiveDocument.Fields("EMAILS").SELECT dir(i)

          ActiveDocument.Fields("EMAILS").lock

          objEmail.To       = ActiveDocument.Fields("EMAILS").GetPossibleValues.ITEM(0).Text

          objEmail.Send


          ActiveDocument.Fields("EMAILS").unlock

          NEXT