Skip to main content
cancel
Showing results for 
Search instead for 
Did you mean: 
Ribeiro
Specialist
Specialist

Como salvar o Nome PDF

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.

2015-12-26_19-40-18.png

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

Neves
14 Replies
Ribeiro
Specialist
Specialist
Author

Obrigado, Alessandro pela paciência e competência.

Ficou perfeito.

2015-12-29_09-02-17.png

Neves
Ribeiro
Specialist
Specialist
Author

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

Neves
afurtado
Partner Ambassador/MVP
Partner Ambassador/MVP

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....

furtado@farolbi.com.br
Ribeiro
Specialist
Specialist
Author

obrigado vou testar...

Neves
Ribeiro
Specialist
Specialist
Author

Alessandro,

Não tinha visto os comandos estavam pronto.

Eu acho que é a katchaça do Ano Novo.

Neves