PDA

View Full Version : Getting a compile Error, Please help!



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

GTO
12-09-2013, 03:44 PM
Hey can anyone help me figure out why this isn't functioning? Thanks!


Hi there,

You should be receiving a "For without Next without For" error; though it is actually a missing End If. You will find that using some consistent indentation will result in easier-to-read code :-)


[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 '<--- Missing

End If

End If

Next i
End Sub



Hope that helps,

Mark