VBA Code to create reminders in Outlook from Excel

[Mcrowe]

Hello all, I am new to the forum and the world of programming via VBA i
excel. The only programming knowledge I have is QBasic from high schoo
-- i.e. i do not remember anything. One too many beers since then...

I am in construction management and I have a log that tracks submitta
dates for various activities. I would like to send the appropriat
person an email or even better an outlook reminder to their calenda
(whichever is easier) to remind them to follow up on and submit. I hav
been playing with some code I got off another forum, but am havin
trouble acheiving what I want, in particular the contents of the body o
the email. Please see the code I inserted below (my questions will b
below that):

Option Explicit

Public Sub SendReminderNotices()
' ****************************************************************
' Define Variables
' ****************************************************************
Dim wkbReminderList As Workbook
Dim wksReminderList As Worksheet
Dim lngNumberOfRowsInReminders As Long
Dim i As Long

' ****************************************************************
' 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
If SendAnOutlookEmail(wksReminderList, i) Then
wksReminderList.Cells(i, 7) = Date 'Indicate Tha
Reminder1 Was Successful
End If
End If
Else
' ****************************************************************
' Second Reminder Date Check
' ****************************************************************
If wksReminderList.Cells(i, 8) = "" Then
If wksReminderList.Cells(i, 4) <= Date Then
If SendAnOutlookEmail(wksReminderList, i) Then
wksReminderList.Cells(i, 8) = Date 'Indicate Tha
Reminder2 Was Successful
End If
End If
End If
End If
Next i

End Sub

Private Function SendAnOutlookEmail(WorkSheetSource As Worksheet
RowNumber As Long) As Boolean
Dim strMailToEmailAddress As String
Dim strSubject As String
Dim strBody As String
Dim OutApp As Object
Dim OutMail As Object

SendAnOutlookEmail = False

strMailToEmailAddress = WorkSheetSource.Cells(RowNumber, 6)
strSubject = "Reminder Notification"
strBody = "Line 1 of Reminder" & vbCrLf & _
"Line 2 of Reminder" & vbCrLf & _
"Line 3 of Reminder"

' ****************************************************************
' 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 = strMailToEmailAddress
.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





When I run this code, it follows my dates and sends an email great. My
issue is that I want the email body to state the "description" from
column A of my spreadsheet, the text heading from the column that
prompted the message and the date of that cell that prompted the email.




I can not get the spreadsheet to attach to this post... Here is how its
set up

Col. A Col. B Col. C Col. D
Col. E Col. F
Description Req'd Finish POST DATE TARGET NAME
EMAIL
Concouse UG 4/21/13 4/12/13 4/5/13 Matt
(e-mail address removed)

There are also:

Col. G Col. H
1st reminder sent 2nd reminder sent
(enters date) (enters date)


To make it more simple... when the code recognizes that a drawing is
due, I want it to send me an email stating the drawing (description) and
the date it is due. Any help would be greatly appreciated!