Envio de e-mail com anexos
Pessoal não absolutamente nada de VBA mas hoje me deparei com anecessidade enviar uma e-mail para varias pessoas como uma mala direta porém terei que enviar com dois anexos, e no e-mail teria logins e senha que seriam dados unicos para cada destinatário, até achei uma planilha em excel com um modolo em vba que faz isso, mas envia apenas um anexo por vez!
abixo estou postando o código aguem sabe posso modificar este código para inserir mais de um anexo no e-mail por vez?
abixo estou postando o código aguem sabe posso modificar este código para inserir mais de um anexo no e-mail por vez?
ub Enviar_Email(Dest As String, Copia As String, Nome As String, AnexItem As String)
'declara variaveis
Dim Assunto As String, Msg As String, AnexPath As String
'atribui assunto
Assunto = Range("assunto")
'atribui mensagem
Msg = Range("mensagem")
'atribui caminhos dos anexos
AnexPath = Range("anexos") & "\" & AnexItem
'verifica se o arquivo existe
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set a = fs.fileexists(AnexPath)
'inclui o nome de destinatario na mensagem
Msg = Replace(Msg, "<%Nome%>", Nome)
'inicia objeto de email do Outlook
Dim oApp As Outlook.Application
Dim oMailItem As Outlook.MailItem
Set oApp = CreateObject("Outlook.Application")
Set oMailItem = oApp.CreateItem(olMailItem)
With oMailItem
.Subject = Assunto
.Body = Msg
.To = Dest
.CC = Copia
If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath)
.Send
End With
End Sub
Sub Enviar_Tudo()
x = 2
Do Until Range("A" & x) = ""
Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x)
x = x + 1
Loop
End Sub
Moisés
Curtidas 0
Melhor post
Jothaz
28/10/2015
Você chegou a analisar os códigos dos links.
No primeiro link no código é criado um array vAnexos (com o range de onde estão os anexos) e depois usa o comando:
Que é justamente para ativar o envio de mais de um anexo.
Infelizmente se os exemplos não lhe ajudaram, sinto muito, mas tenho como sugerir mais nada.
Vamos aguardar outras sugestões e desejo-te boa sorte.
No primeiro link no código é criado um array vAnexos (com o range de onde estão os anexos) e depois usa o comando:
vAnexos = Application.GetOpenFilename(Title:="Anexar arquivos", MultiSelect:=True)
Que é justamente para ativar o envio de mais de um anexo.
Infelizmente se os exemplos não lhe ajudaram, sinto muito, mas tenho como sugerir mais nada.
Vamos aguardar outras sugestões e desejo-te boa sorte.
GOSTEI 1
Mais Respostas
Moisés
27/10/2015
Alguém me dá uma força ai por favor!!
GOSTEI 0
Jothaz
27/10/2015
Tem décadas que não programo em VBA, mas dê um olhada aqui:
Anexando arquivos
http://www.hardware.com.br/comunidade/ajuste-email/1041019/
Anexando arquivos
http://www.hardware.com.br/comunidade/ajuste-email/1041019/
GOSTEI 0
Moisés
27/10/2015
Jothaz, valeu pelos Links, mas o que preciso é apenas uma maneira de enviar mais um anexo, o código tenho acima envia para vários usuários mas apenas um 1 arquivo como anexo, quero poder enviar mais um arquivo, creio que seja necessário fazer algum loop, mas sei nada de VB
GOSTEI 0
Moisés
27/10/2015
Blz não não consegui usar isso no meu código!
GOSTEI 0
Moisés
27/10/2015
Dei uma olhada no que o Jothaz citou mas não consegui inseri-lo meu, alguém poderia me ajudar por favor.
GOSTEI 0
Moisés
27/10/2015
Pessoal boa Tarde, consegui resolver, agora consigo anexar quantos arquivos quizer, porém o anexo tem que ser igual para todos os usuários.
'Sub Enviar_Email(Dest As String, Copia As String, Nome As String, AnexItem As String)
Sub Enviar_Email(Dest As String, Copia As String, Nome As String, Usuario As String)
'declara variaveis
Dim Assunto As String, Msg As String ', AnexPath As String
'atribui assunto
Assunto = Range("assunto")
'atribui mensagem
Msg = Range("mensagem")
'atribui caminhos dos anexos
'AnexPath = Range("anexos") & "\" & AnexItem
'verifica se o arquivo existe
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set a = fs.fileexists(AnexPath)
'inclui o nome de destinatario na mensagem
Assunto = Replace(Assunto, "<%Nome%>", Nome)
Msg = Replace(Msg, "<%Usuario%>", Usuario)
'inicia objeto de email do Outlook
Dim oApp As Outlook.Application
Dim oMailItem As Outlook.MailItem
Set oApp = CreateObject("Outlook.Application")
Set oMailItem = oApp.CreateItem(olMailItem)
With oMailItem
.Subject = Assunto
.Body = Msg
.To = Dest
.CC = Copia
'If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath)
.Attachments.Add "C:\Users\NAC\Desktop\anexo1.pdf"
.Attachments.Add "C:\Users\NAC\Desktop\anexo2.pdf"
.Send
End With
End Sub
Sub Enviar_Tudo()
x = 2
Do Until Range("A" & x) = ""
Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x)
'Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x)
x = x + 1
Loop
End Sub
GOSTEI 0
Bianca
27/10/2015
Boa Tarde Moisés,
Estou com uma dificuldade imensa com VBA também não entendo nada, como faço para colocar esse código no Excel?
preciso enviar 1.800 e-mails com mais de um anexo..
Estou com uma dificuldade imensa com VBA também não entendo nada, como faço para colocar esse código no Excel?
preciso enviar 1.800 e-mails com mais de um anexo..
GOSTEI 0