Hi All,
This is the first time I'm posting on this forum and I'm a Macro dummy right now so I need some help.
I have a list of 200+ emails which I would need to send individual emails to as they require different attachment for them.
Here is what I have:
Column A - To Email
Column B - CC Emails
Column C - Body
Column D - Attachment (File Path)
<tbody>
</tbody>
What I need the VBA to do is to send A1 and CC B1 with C1 Body and with D1 attachment.
Here is my current code:
The current code does not send the emails properly and I can't figure whether is my range format incorrect. When i run the code, it will send the email however it will only send to A1 and B1 recipients with Attachments from both D1 and D2.
Also, is there a way to just point the body to one single cell for all e-mails? The body would stay the same for all 200+ emails so I would only need one cell to do this.
Please help me out! If not i would have to manually send out 200+ emails!!
This is the first time I'm posting on this forum and I'm a Macro dummy right now so I need some help.
I have a list of 200+ emails which I would need to send individual emails to as they require different attachment for them.
Here is what I have:
Column A - To Email
Column B - CC Emails
Column C - Body
Column D - Attachment (File Path)
To | CC | Body | Attachment |
example1@hotmail.com | cc1@mail.com; cc2@mail.com; cc3@mail.com | Example Body | C:\Users\Desktop\Example.xls |
example2@hotmail.com | cc4@mail.com; cc5@mail.com; cc6@mail.com | Example Body | C:\Users\Desktop\Example2.xls |
<tbody>
</tbody>
What I need the VBA to do is to send A1 and CC B1 with C1 Body and with D1 attachment.
Here is my current code:
VBA Code:
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the D:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
.CC = ThisWorkbook.Sheets("Sheet1").Range("B1").Value
.Subject = "Example Subject 1"
.Body = ThisWorkbook.Sheets("Sheet1").Range("C1").Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display/Send
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
The current code does not send the emails properly and I can't figure whether is my range format incorrect. When i run the code, it will send the email however it will only send to A1 and B1 recipients with Attachments from both D1 and D2.
Also, is there a way to just point the body to one single cell for all e-mails? The body would stay the same for all 200+ emails so I would only need one cell to do this.
Please help me out! If not i would have to manually send out 200+ emails!!