Array
(
)

Envio de e-mail com anexos

Moisés
   - 27 out 2015

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?
#Código

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
   - 28 out 2015

Alguém me dá uma força ai por favor!!

Jothaz
   - 28 out 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/

Moisés
   - 28 out 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

Jothaz
   - 28 out 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:

#Código

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.

Moisés
   - 28 out 2015

Blz não não consegui usar isso no meu código!

Moisés
   - 29 out 2015

Dei uma olhada no que o Jothaz citou mas não consegui inseri-lo meu, alguém poderia me ajudar por favor.

Moisés
   - 29 out 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.
#Código

'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