Hi all
My team and I send more than 1000 emails via Outlook to customers requesting for payments on a regular basis. The payment needs to be received in 10 working days. If payment isn't received by the due date then follow up email is required. I found a code to do this but the problem is the vba still sends an email to everyone rather than just the people who haven't been followed up. Can someone please help to stop unnecessary follow ups being sent? Thank you so so much!
Column A = Division
Column B = Department
Column C = Payment Description
Column D = Date invoice was sent
Column E = Date payment was received
Column F = Date follow up is required
Column G = Date Overdue Notice was sent
Column H = Date final notice needs to be sent
Column I = Date final notice is sent
Column J = Email Address
Here's the code:
Sub Overdue()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim sourceCol As Integer
Dim currentRowValue As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
ThisWorkbook.Sheets("Sheet1").Select
lRow = Cells(Rows.Count, 10).End(xlUp).Row
For i = 3 To lRow
toDate = Replace(Cells(i, 6), ".", "/")
If Left(Cells(i, 6), 10) <> "Mail" And toDate - Date < 0 Then
Set outapp = CreateObject("Outlook.Application")
Set OutMail = outapp.CreateItem(0)
toList = Cells(i, 10)
eSubject = "xxxx"
eBody = "xxxx"
On Error Resume Next
With OutMail
.sentonbehalfofname = "xxxx"
.To = toList
.CC = toDel
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set outapp = Nothing
Cells(i, 7) = Date + Time
End If
Next i
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Bookmarks