Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Tenho o código abaixo de uma macro, que está funcionando perfeitamente.
Precisava, trocar o nome do PDF Salvo.
QlikView Printing.pdf. igual na imagem
Algo que pudesse colocar ao lado do ID do Relatório.
a)Alguma dica, de como melhorar o código abaixo, para que posso escolher o nome do pdf.
b)Existe como salvar o mesmo pdf no mesmo email anexado.
Tipo dois anexos no mesmo email.
Estou usando PDFCreator. a enviar para ele ele enviar email automaticamente.
sub PrintReport
ActiveDocument.Reload
ActiveDocument.PrintDocReport "RP01","Teste"
ActiveDocument.PrintDocReport "RP02","Teste"
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
ActiveDocument.Save
ActiveDocument.GetApplication.Quit
end sub
Obrigado, Alessandro pela paciência e competência.
Ficou perfeito.
Preciso fazer carga no arquivo ao entrar.
Estou usando disparadores.
ActiveDocument.Reload
Preciso Salvar o QVW.
ActiveDocument.Save
Preciso fechar a aplicação ao terminar.
ActiveDocument.GetApplication.Quit
Por favor, aonde eu coloco este 03 comando no código abaixo.
Obrigado
ActiveDocument.Reload
ActiveDocument.Save
ActiveDocument.GetApplication.Quit
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\Estoque.pdf") then
filesys.DeleteFile "C:\tmp\Estoque.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\Auditoria.pdf") then
filesys.DeleteFile "C:\tmp\Auditoria.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\Estoque.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\Auditoria.pdf"
End If
Set filesys = Nothing
ActiveDocument.GetApplication.Sleep 3000
'===========================================================================================
' Aqui roda o relatorio ID RP02
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\Financeiro.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") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
'---------------------------------------------------------------------
End With
'Destinatarios = TabelaEmails.Item(contEmail).Text
Destinatarios = "athenas1200@gmail.com"
objEmail.To = Destinatarios
'objEmail.CC = "nn@mm.com.br"
objEmail.From = "athenas1200@gmail.com"
objEmail.Subject = "Relatórios Gerenciais."
objEmail.HTMLBody = "Relatórios Gerenciais."
'===========================================================================================
'Aqui colocamos os anexos.....
objEmail.AddAttachment "C:\tmp\VendasdoDia.pdf"
objEmail.AddAttachment "C:\tmp\Estoque.pdf"
objEmail.AddAttachment "C:\tmp\Auditoria.pdf"
objEmail.AddAttachment "C:\tmp\Financeiro.pdf"
'===========================================================================================
objEmail.Send
'===========================================================================================
'Aqui apagamos os arquivos pois senao da erro na proxima vez.....
'Next
'ActiveDocument.Fields("Gerente").Clear ' Limpar Filtro por Email
End Sub
Eles já estão la....
Sub ExecMacro()
'ActiveDocument.Reload
Envio()
'ActiveDocument.Save
'ActiveDocument.GetApplication.Quit
'ActiveDocument.GetApplication.Close
End Sub
basta descomentar....Tirar o ' da frente da linha....
obrigado vou testar...
Alessandro,
Não tinha visto os comandos estavam pronto.
Eu acho que é a katchaça do Ano Novo.