Excel Vba to send mail with several attachments

[TVB]

Hi everyone,
I am trying to send an automatic email an I am having trouble with attaching more than one file.
I have the complete file path in one cell and it os going there to attach, but it is only working for one attachment.

This is the code:
Sub MailAutomático()

a = 1

'Calcular quantas linhas a tabela dos e-mails
Do Until Sheets("Mail").Cells(a, 1) = ""
a = a + 1
Loop

'escolher o email de destino(
For i = 2 To a - 1
If Sheets("Mail").Cells(i, 1) = "Não" Then


Else

Mail = Sheets("Mail").Cells(i, 3) ' Guarda o e-mail enviar na variavel Mail
'Agente = Sheets("Filtro").Cells(i, 1) ' Gravar nome do agente
Auditor = Sheets("Mail").Cells(i, 4) ' Gravar nome do auditor
Tempo = Sheets("Mail").Cells(i, 5)
Anexo = Sheets("Mail").Cells(i, 15)

'Abre o Outlook e cria o e-mail

Dim aOutlook As Object
Dim myAttatchments As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String

Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'Set myAttatchments = outlookmailitem.Attatchments

'set mail da pessoa para mandar
aEmail.To = Mail
'set cc
aEmail.CC = Auditor
'set Importance
aEmail.Importance = 1
'Set Subject
aEmail.Subject = " ComparaJá.pt: Pedido de Proposta: " & Sheets("Mail").Cells(i, 11) & " - " & Sheets("Mail").Cells(i, 12) & " " & Sheets("Mail").Cells(i, 13)
'Set Body for mail
aEmail.HTMLBody = "Caro parceiro,<br/><br/>Junto envio um pedido de proposta para um <b>crédito habitação - " & Sheets("Mail").Cells(i, 10) & ".</b><br/><br/>Solicitamos a vossa melhor proposta no próximo dia para apresentar ao cliente.<br/><br/><b>Toda a informação recolhida foi analisada através da documentação diponibilizada pelo cliente, que será posteriormente partilhada caso o cliente decida avançar com a vossa Instituição<br/><br/>Taxa: </b>" & Sheets("Mail").Cells(i, 7) & "<br/><b>Prazo: </b>" & Sheets("Mail").Cells(i, 5) & " meses<br/><b>Montante: </b>" & Sheets("Mail").Cells(i, 6) & "€<br/><b><span style=""color:#80BFFF"">Tipo de Seguro de Vida: " & Sheets("Mail").Cells(i, 8) & "(Cobertura a 100%)</span style=""color:#80BFFF""> - É possível apresentar FINE com este tipo de seguro?<br/><br/>Zona Preferencial:</b><br/><br/>Agradecemos também se pudessem verificar se o cliente em questão já tem o processo a decorrer com algum balcão do banco.<br/><br/>" & _
"Tal como estabelecido contratualmente o contacto ao cliente não deve ser feito no seguimento deste email, mas apenas depois de encaminhamento de contactos."


'set anexo do mail
aEmail.Attachments.Add Anexo
'or send one off to 1 person use this static code
'aEmail.Recipients.Add "E-mail.address-here@ntlworld.com"
'Send Mail
aEmail.Display ' Mudar para Send depois de macro Ok
End If
Next
End Sub

 

[Ron de Bruin]

you can repeat this line
Attachments.Add

You can also add a code loop through a few cells and test if the file exists and if it is add it

 

[ayman helmy]

you can repeat this line
Attachments.Add

You can also add a code loop through a few cells and test if the file exists and if it is add it

i have the same issue and i use this code below what should i do


Sub BulkMail()
Application.ScreenUpdating = False

ThisWorkbook.Activate
'Creating references to Application and MailItem Objects of Outlook
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem

'Creating variable to hold values of different items of mail
Dim sendTo, subj, atchmnt, msg, ccTo, bccTo As String

Dim lstRow As Long

'My data is on sheet "Exceltip.com" you can have any sheet name.

ThisWorkbook.Sheets("Exceltip.com").Activate
'Getting last row of containing email id in column 3.
lstRow = Cells(Rows.Count, 3).End(xlUp).Row

'Variable to hold all email ids

Dim rng As Range
Set rng = Range("C2:C" & lstRow)

'initializing outlook object to access its features
Set outApp = New Outlook.Application
On Error GoTo cleanup 'to handle any error during creation of object.

'Loop to iterate through each row, hold data in of email in variables and send 'mail to each email id.

For Each cell In rng
sendTo = Range(cell.Address).Offset(0, 0).Value2
subj = Range(cell.Address).Offset(0, 1).Value2 & "-MS"
msg = Range(cell.Address).Offset(0, 2).Value2
atchmnt = Range(cell.Address).Offset(0, -1).Value2
ccTo = Range(cell.Address).Offset(0, 3).Value2
bccTo = Range(cell.Address).Offset(0, 4).Value2

On Error Resume Next 'to hand any error during creation of below object
Set outMail = outApp.CreateItem(0)

'Writing and sending mail in new mail
With outMail
.To = sendTo
.cc = ccTo
.BCC = bccTo
.Body = msg
.Subject = subj
.Attachments.Add atchmnt
.Send 'this send mail without any notification. If you want see mail
'before send, use .Display method.
End With
On Error GoTo 0 'To clean any error captured earlier
Set outMail = Nothing 'nullifying outmail object for next mail
Next cell 'loop ends

cleanup: 'freeing all objects ceated
Set outApp = Nothing
Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

See this page for more info : Mail a different file(s) to each person in a range