How to send automated mail from excel with multiple attchment using outlook application

 Today We will learn how to send email from excel automatically.

First of all You need to create a table in excel. In my case I have created a table where

1st Column is Recipient Name

2nd Column has email address

and 3rd column has massage

4th, 5th, & 6th column is for attachment where we put only file path which file you want to insert in your mail. If you would not want to sent attachment then keep this cells blank. And the last Column is Status. If you send mail then status will change to "EMAIL has been sent". Email will be sent only when if the status is blank or not equal to "EMAIL has been sent"

The VBA codes which I used.....

Option Explicit

Sub sendmail()

Dim outlookApp As Object

Dim Email As Object

Dim Subj As String

Dim mailAddress As String

Dim Msg As String

Dim cell As Range

Dim Recipient As String

Dim Attchm1, Attchm2, Attchm3 As String

' create outlook object

Set outlookApp = CreateObject("Outlook.Application")

Subj = "Learn about Excel VBA"

'loop

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

If cell.Value Like "*@*" And cell.Offset(0, 5).Value <> "EMAIL has been Sent" Then

mailAddress = cell.Value

Recipient = cell.Offset(0, -1).Value

'compose massage

Msg = "Dear" & Recipient & vbNewLine & cell.Offset(0, 1)

Attchm1 = cell.Offset(0, 2).Value

Attchm2 = cell.Offset(0, 3).Value

Attchm3 = cell.Offset(0, 4).Value

'create mail and send it

Set Email = outlookApp.createitem(0)

With Email

.to = mailAddress

.Subject = Subj

.body = Msg & vbNewLine & "Thanks & regards" & vbNewLine & "Nimai Sutradhar" _

& vbNewLine & Date & " " & Time

If Attchm1 <> "" Then

.attachments.Add Attchm1

Else

End If

If Attchm2 <> "" Then

.attachments.Add Attchm2

Else

End If

If Attchm3 <> "" Then

.attachments.Add Attchm3

Else

End If

.display

.send

End With

cell.Offset(0, 5).Value = "EMAIL has been Sent"

End If

Next

Set Email = Nothing

Set outlookApp = Nothing

End Sub

Here I used a loop function to check every cell value. and the base column is "B" by using 

For Each cell In Columns("B"). which is .offset(0,0)

So that Column A will be .offset(0,-1)

and Column C will be .offset(0,1) and so on.

I have used another vba code to get file path

Option Explicit

Sub File_Path()

Dim FilePath As String

With Application.FileDialog(msoFileDialogFilePicker)

If .Show <> 0 Then

FilePath = .SelectedItems(1)

ActiveCell = FilePath

End If

End With

End Sub

Now insert shapes to set assign macro and call this macros by clicking right click on the shapes and goto assign macro, Now click on New and write vba code to call the macro

Option Explicit

Sub RectangleRoundedCorners3_Click()

Call sendmail

End Sub

Sub RectangleRoundedCorners4_Click()

Call File_Path

End Sub

If you want to download this file then click here.

N.B > first you need to login outlook application on your computer, then build your vba codes.

For Supports Please Subscribe my channel.