Send Multiple Mail with Excel VBA

Thank you to all who proactively supported in getting this error answered.


ORIGINAL SCRIPT

Option Explicit

Sub SendMultipleEMails()

Dim emailApplication As Object
Dim emailItem As Object
Dim lastRow As Long
Dim rng As Range
Dim cell As Range


'''Set the RANGE to run'''
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A1:F" & lastRow)


''' THE EMAIL TO OUTLOOK '''
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

With emailItem

.To = Cells(i, 1).Value
.CC = Cells(i, 2).Value
.Subject = Cells(i, 3).Value
.Body = Cells(i, 4).Value
''.Attachments.Add Cells(i, 5).Value

.Display

End With

On Error GoTo 0

Set emailItem = Nothing
Set emailApplication = Nothing


End Sub




SOLVED SCRIPT (after consolidating the answers)

Sub SendMultipleEMails()

Dim emailApplication As Object
Dim emailItem As Object
Dim lastRow As Long
Dim i As Integer

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

Set emailApplication = CreateObject("Outlook.Application")

For i = 2 To lastRow
Set emailItem = emailApplication.CreateItem(0)

With emailItem

.To = Cells(i, 1).Value
.CC = Cells(i, 2).Value
.Subject = Cells(i, 3).Value
.Body = Cells(i, 4).Value

''' ADDING ATTACHMENT '''
If Cells(i, 5).Text <> "" Then
.Attachments.Add Cells(i, 5).Text
End If

If Cells(i, 6).Text <> "" Then
.Attachments.Add Cells(i, 6).Text
End If

If Cells(i, 7).Text <> "" Then
.Attachments.Add Cells(i, 7).Text
End If

.Display

End With

On Error GoTo 0

Set emailItem = Nothing
Next i
Set emailApplication = Nothing


End Sub