beninbb
12-09-2013, 02:22 PM
Hey can anyone help me figure out why this isn't functioning? Thanks!
Option Explicit
Public Sub SendReminderNotices()
' ****************************************************************
' Define Variables
' ****************************************************************
Dim wkbReminderList As Workbook
Dim wksReminderList As Worksheet
Dim lngNumberOfRowsInReminders As Long
Dim i As Long
Dim strSubject as string, strBody as string, strEmail as String
' ****************************************************************
' Set Workbook and Worksheet Variables
' ****************************************************************
Set wkbReminderList = ActiveWorkbook
Set wksReminderList = ActiveWorkbook.ActiveSheet
' ****************************************************************
' Determine How Many Rows Are In the Worksheet
' ****************************************************************
lngNumberOfRowsInReminders = wksReminderList.Cells(Rows.Count, "A").End(xlUp).Row
' ****************************************************************
' For Any Items That Don't Have A Date In Columns 7 or 8,
' Check To See If The Reminder Is Due.
'
' If Reminder Is Due, then Send An Email.
' If Successful, Log The Date Sent in Column 7 or 8
' ****************************************************************
For i = 2 To lngNumberOfRowsInReminders
' ****************************************************************
' First Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 7) = "" Then
If wksReminderList.Cells(i, 3) <= Date Then
strEmail = wksReminderList.Cells(i, 6).Value
strSubject = "First Reminder"
strBody = "text here..."
If SendAnOutlookEmail(strEmail, strSubject, strBody) Then
wksReminderList.Cells(i, 7) = Date
End If
End If
Else
' ****************************************************************
' Second Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 8) = "" Then
If wksReminderList.Cells(i, 4) <= Date Then
strEmail = wksReminderList.Cells(i, 6).Value
strSubject = "Second Reminder!!!"
strBody = "other text here..."
If SendAnOutlookEmail(strEmail, strSubject, strBody) Then
wksReminderList.Cells(i, 8) = Date
End If
End If
End If
Next i
End Sub
Private Function SendAnOutlookEmail(strAddress as String, _
strSubject as String, _
strBody as String) As Boolean
Dim OutApp As Object
Dim OutMail As Object
SendAnOutlookEmail = False
' ****************************************************************
' Create The Outlook Mail Object
' ****************************************************************
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon "Outlook"
Set OutMail = OutApp.CreateItem(0)
' ****************************************************************
' Send The Email
' ****************************************************************
On Error GoTo ErrorOccurred
With OutMail
.To = strAddress
.Subject = strSubject
.Body = strBody
.Send
End With
' ****************************************************************
' Mail Was Successful
' ****************************************************************
SendAnOutlookEmail = True
Continue:
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Exit Function
' ****************************************************************
' Mail Was Not Successful
' ****************************************************************
ErrorOccurred:
Resume Continue
End Function
Option Explicit
Public Sub SendReminderNotices()
' ****************************************************************
' Define Variables
' ****************************************************************
Dim wkbReminderList As Workbook
Dim wksReminderList As Worksheet
Dim lngNumberOfRowsInReminders As Long
Dim i As Long
Dim strSubject as string, strBody as string, strEmail as String
' ****************************************************************
' Set Workbook and Worksheet Variables
' ****************************************************************
Set wkbReminderList = ActiveWorkbook
Set wksReminderList = ActiveWorkbook.ActiveSheet
' ****************************************************************
' Determine How Many Rows Are In the Worksheet
' ****************************************************************
lngNumberOfRowsInReminders = wksReminderList.Cells(Rows.Count, "A").End(xlUp).Row
' ****************************************************************
' For Any Items That Don't Have A Date In Columns 7 or 8,
' Check To See If The Reminder Is Due.
'
' If Reminder Is Due, then Send An Email.
' If Successful, Log The Date Sent in Column 7 or 8
' ****************************************************************
For i = 2 To lngNumberOfRowsInReminders
' ****************************************************************
' First Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 7) = "" Then
If wksReminderList.Cells(i, 3) <= Date Then
strEmail = wksReminderList.Cells(i, 6).Value
strSubject = "First Reminder"
strBody = "text here..."
If SendAnOutlookEmail(strEmail, strSubject, strBody) Then
wksReminderList.Cells(i, 7) = Date
End If
End If
Else
' ****************************************************************
' Second Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 8) = "" Then
If wksReminderList.Cells(i, 4) <= Date Then
strEmail = wksReminderList.Cells(i, 6).Value
strSubject = "Second Reminder!!!"
strBody = "other text here..."
If SendAnOutlookEmail(strEmail, strSubject, strBody) Then
wksReminderList.Cells(i, 8) = Date
End If
End If
End If
Next i
End Sub
Private Function SendAnOutlookEmail(strAddress as String, _
strSubject as String, _
strBody as String) As Boolean
Dim OutApp As Object
Dim OutMail As Object
SendAnOutlookEmail = False
' ****************************************************************
' Create The Outlook Mail Object
' ****************************************************************
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon "Outlook"
Set OutMail = OutApp.CreateItem(0)
' ****************************************************************
' Send The Email
' ****************************************************************
On Error GoTo ErrorOccurred
With OutMail
.To = strAddress
.Subject = strSubject
.Body = strBody
.Send
End With
' ****************************************************************
' Mail Was Successful
' ****************************************************************
SendAnOutlookEmail = True
Continue:
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Exit Function
' ****************************************************************
' Mail Was Not Successful
' ****************************************************************
ErrorOccurred:
Resume Continue
End Function