Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
O Código abaixo está funcionando.
Ele geras o pdf corretamente, Mas só gerar o email: "RP01" ,"Gerente"
Como faço para gerar também para o "RP02", "Gerente2"
Onde está errado a linha de código.
Alguma dica...
Estou tentando enviar dois anexo RP01 - Gerente - athenas1200@gmail.com
RP02 - Gerente2 - contato@consultoriasoft.com.br
Lendo os email:
*************************************************************************************************************************
LOAD * INLINE [
Gerente
];
LOAD * INLINE [
Gerente2
contato@consultoriasoft.com.br
];
*******************************************************************************************************************************
Codigo do Macro:
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
Set TabelaEmails = ActiveDocument.Fields("Gerente2").GetPossibleValues(1000)
ActiveDocument.Fields("Gerente2").Select TabelaEmails.Item(contEmail).Text
ActiveDocument.PrintDocReport "RP02", "Gerente2"
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 = "teste@contalsoft.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","Gerente2").Clear ' Limpar Filtro por Email
End Sub
Fiz este modelo com exemplo de mandar gerente1 e gerente2 com cada gerente com varios nomes e outro com somente gerando pdf e mandando dois pdf um para cada gerente, mas sem campo filtrando....
Testei e esta funcionando.....
A parte do código poderia ter sido criado function para chamar as partes repetidas......Mas não fiz.....
Agnaldo,
para anexar os dois relatorios ao criar poderias usar nomes diferentes. Como usa o mesmo (se o email for o mesmo) poderias anexar ao nome uma variacao _1 _2 e poder anexar os dois.....
objEmail.AddAttachment "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text &_1 ".pdf"
objEmail.AddAttachment "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text &_2".pdf"
Ainda estou fazendo algo errado no código.
Está com erro.
Sub Envio()
Set TabelaEmails = ActiveDocument.Fields("Gerente").GetPossibleValues(1000)
For contEmail = 0 to TabelaEmails.Count - 1
ActiveDocument.Fields("Gerente").Select TabelaEmails.Item(contEmail).Text1
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).Text1 & ".pdf") then
filesys.DeleteFile "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text1 & ".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).Text1 & ".pdf"
End If
ActiveDocument.GetApplication.Sleep 1000
Set TabelaEmails = ActiveDocument.Fields("Gerente2").GetPossibleValues(1000)
ActiveDocument.Fields("Gerente2").Select TabelaEmails.Item(contEmail).Text2
ActiveDocument.PrintDocReport "RP02", "Gerente2"
PrintReport()
ActiveDocument.GetApplication.Sleep 2000
Set filesys = Nothing
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text2 & ".pdf") then
filesys.DeleteFile "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text2 & ".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).Text2 & ".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 = "teste@contalsoft.com.br"
objEmail.Subject = "Gerencia : " & TabelaEmails.Item(contEmail).Text
objEmail.HTMLBody = ""
objEmail.AddAttachment "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text1 & ".pdf"
objEmail.AddAttachment "C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text2 & ".pdf"
objEmail.Send
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text1 & ".pdf") then
'If filesys.FileExists("C:\tmp\Relatório Gerente - " & TabelaEmails.Item(contEmail).Text2 & ".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","Gerente2").Clear ' Limpar Filtro por Email
End Sub
Dica:
Bom se tivesse como inserir no LOAD assim,
Na carga do email, eu pudesse criar perfil com o email e indicado qual PDF ele receberia, aqui.
Seria fantástico. O código ficaria muito bacana.
Lendo os email:
*************************************************************************************************************************
LOAD * INLINE [
Gerente , Relatório
,mailto:athenas1200@gmail.com, RP01
];
LOAD * INLINE [
Gerente2, Relatório
contato@consultoriasoft.com.br, RP02
];
O erro esta
.Text1 &
e
.Text2 &
tem que colocar o 1 ou 2 depois do &
.Text & "2.pdf" por exemplo
Alessandro, Todo o código veja se o amigo conseguer ver o que está errado.
O erro esta ai......Tem 2 if e 1 endif
Faz dois blocos.......
A unica mudança que fiz foi nesta parte,
mas ainda está com erro.
O ideal seria ir comentando partes do código para tentar identificar o erro ou você disponibiliza o modelo para ver se eu acho o erro......
Está acima Alessandro
Obrigado pela força