Excel Vba to send mail with several attachments

TVB

New Member
Joined
Feb 3, 2021
Messages
1
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Ron de Bruin

Active Member
Joined
Aug 1, 2006
Messages
271
Platform
  1. Windows
  2. MacOS
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

New Member
Joined
Mar 17, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,098
Messages
5,622,690
Members
415,920
Latest member
ExcelNoob28

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top