Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Tenho esta macro que está funcionando bem,
Mas apareceu outro relatório para enviar junto.
Seria
Só que fazendo assim. Não funciona. Como seria o Código correto.
Para enviar dois pdf no mesmo email. RP01 E RP02
A linha do código que trata e está. abaixo.
ActiveDocument.PrintDocReport "RP01", "Gerente"
sub PrintReport
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
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
ActiveDocument.Fields("Gerente").Select TabelaEmails.Item(contEmail).Text
ActiveDocument.PrintDocReport "RP01", "Gerente"
PrintReport()
ActiveDocument.GetApplication.Sleep 2000
Set filesys = Nothing
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf") then
filesys.DeleteFile "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"
End If
ActiveDocument.GetApplication.Sleep 1000
Set filesys = Nothing
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("C:\tmp\QlikView Printing.pdf") then
filesys.MoveFile "C:\tmp\QlikView Printing.pdf", "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"
End If
ActiveDocument.GetApplication.Sleep 1000
vRepositorio = GetVariable("vRepositorio")
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 = "teste@teste.ind.br"
objEmail.To = Destinatarios
'objEmail.CC = "nn@mm.com.br"
objEmail.From = "mmmm@nnnn.com.br"
objEmail.Subject = "Gerencia : " & TabelaEmails.Item(contEmail).Text
objEmail.HTMLBody = ""
objEmail.AddAttachment "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"
objEmail.Send
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf") then
filesys.DeleteFile "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text & ".pdf"
End If
ActiveDocument.GetApplication.Sleep 2000
Set filesys = Nothing
Next
ActiveDocument.Fields("Gerente").Clear ' Limpar Filtro por Email
End Sub
Resolvido,