3 Replies Latest reply: May 3, 2017 4:35 PM by Agnaldo Neves RSS

    Selecionar a impressora pdf creator ao disparar email

    Agnaldo Neves

      Tenho o código abaixo e funciona bem.

      Mas tem um problema. Não consigo escolher uma impressora .

      Exemplo precisava fixar a impressora ao imprimir.

      Mas o usuário esquecer de trocar a impressora padrão ahi vai tudo para impressão

       

      Alguém tem algum código que antes de fazer a impressão deixar uma impressora padrão e volte ela novamente.

      Alguma idéia.

       

       

       

       

      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\VendasdoDia.pdf") then
        filesys.DeleteFile "C:\tmp\VendasdoDia.pdf"
        End If
        Set filesys = Nothing
              Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists("C:\tmp\Financeiro.pdf") then
        filesys.DeleteFile "C:\tmp\Financeiro.pdf"
        End If
        Set filesys = Nothing
              Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists("C:\tmp\receber.pdf") then
        filesys.DeleteFile "C:\tmp\receber.pdf"
        End If
        Set filesys = Nothing
              Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists("C:\tmp\Evolucao.pdf") then
        filesys.DeleteFile "C:\tmp\Evolucao.pdf"
        End If
        Set filesys = Nothing
              Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists("C:\tmp\pagar.pdf") then
        filesys.DeleteFile "C:\tmp\pagar.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\VendasdoDia.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\Financeiro.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\pagar.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\Evolucao.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\receber.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") = 60
        .Update
        '---------------------------------------------------------------------
        End With'
        'Destinatarios     = TabelaEmails.Item(contEmail).Text
        'Destinatarios     = "meuemail@hotmail.com"
        Destinatarios     = "meuemail@gmail.com"
        objEmail.To       = Destinatarios
           
        objEmail.Bcc      =  "meuemail@gmail.com"
        objEmail.From     = "meuemail@gmail.com"
        objEmail.Subject  = "Relatórios Gerenciais."
        objEmail.HTMLBody = "Relatórios Gerenciais - Favor não responder este e-mail - Enviado automaticamente. www.consultoriasoft.com.br"
              '===========================================================================================
              'Aqui colocamos os anexos.....
        objEmail.AddAttachment "C:\tmp\VendasdoDia.pdf"
        objEmail.AddAttachment "C:\tmp\Financeiro.pdf"
        objEmail.AddAttachment "C:\tmp\pagar.pdf"
        objEmail.AddAttachment "C:\tmp\Evolucao.pdf"
        objEmail.AddAttachment "C:\tmp\receber.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