Sub SendMail()
Dim r As Long
Dim m As Long
Dim objOL As Object
Dim objMsg As Object
Dim blnStart As Boolean
On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
If objOL Is Nothing Then
MsgBox "Can't start Outlook", vbExclamation
Exit Sub
End If
blnStart = True
End If
On Error GoTo ErrHandler
m = Cells(Rows.Count, 1).End(xlUp).Row
For r = 4 To m
If Cells(r, 4) < 30 And Not Cells(r, 5) = True Then
Set objMsg = objOL.CreateItem(0)
With objMsg
.Recipients.Add Cells(r, 1)
.Subject = "ABC"
.CC = "abc@gmail.com"
.Body = "Dear " & _
Cells(r, 2) & "," & vbCrLf & vbCrLf & _
"Your license will expire on " & Cells(r, 3) & "."
.Send ' use .Display while testing.
End With
MsgBox "All done", vbInformation, "Finish"
Sheets("Sheet1").Range("F1").Value = Date
End If
Next r
ExitHandler:
On Error Resume Next
Set objMsg = Nothing
If blnStart Then
objOL.Quit
End If
Set objOL = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
|