For Each Loop to Send Multiple E-mails|VBA & Macros|Excel Forum|My Online Training Hub

Hello,

I'm wondering if anyone can help me decipher what I've missed in my VBA code? I'm trying to write a For Each Loop that looks at the due date in Column J and sends out a reminder e-mail if the date is within 7 days. 

The code works great the first time, but will not continue through the loop to look at the remaining dates in rows 4-26 of column J. It pops up with an error stating "Ru-time error '-2147221238 (8004010a)': The item has been removed or deleted."

When clicking on debug following this error, it highlights the code line where the e-mail to address is located. I've tried both hardcoding the address and using a range object, but neither seem to resolve the error message.

I've included the code has it reads currently below. Any help is greatly appreciated!!

Sub Email_From_Excel_Basic()

Dim emailApplication As Object
Dim emailItem As Object
Dim DateDueCol As Range
Dim DateDue As Range

Set DateDueCol = Range("J3:J26")
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

For Each DateDue In DateDueCol

If DateDue <> "" And DateDue >= DateDue - Range("T1") Then

emailItem.To = Range("V5").Value

emailItem.Subject = "DOT Scheduling Reminder"

emailItem.Body = "This is a reminder that the DOT for Trailer " & DateDue.Offset(0, -8) & " is due on " & DateDue & " . Please schedule a DOT for this trailer."

emailItem.Send

End If

Next DateDue

End Sub

Thanks again!

Amanda