Selecionar a impressora pdf creator ao disparar email

[Ribeiro]

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

[Ribeiro]

Amigos achei este bat funcionou..

Vou usar ao carregar junto com o bat...

RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n "Snagit 11"

[#3]

Agnaldo, se der certo, marque sua resposta como correta pra fechar o tópico.

Abraços

[Ribeiro · Accepted solution]

Olá Luana,

Está correta sim,

Mas é correto você mesmo fechar o tópico.

eu coloquei como foi supostamente respondida.

Mas vou fechar. agradeço

muito obrigado.

agnaldo