VBA - Outlook Task Creation - Recipient based on Dynamic Range - vba

Question

As of right now, the below function works, however I need to change the Recipient.Add field to the corresponding email address, with each change. All of my email address are listed in a column on the worksheet, and ideally I would like the function to just automatically add the correct email based on the Row.
I am calling the function using =AddtoTasks(A1,C1,D1) where A1 is the Date, C1, and the Text, and D1, is the amount of days prior to A1, I need the reminder to pop up. All of my Outlook References are correctly added, just need help figuring out the email address.
Excel and Outlook 2010
Option Explicit
Dim bWeStartedOutlook As Boolean
Function AddToTasks(strDate As String, strText As String, DaysOut As Integer) As Boolean
Dim intDaysBack As Integer
Dim dteDate As Date
Dim olApp As Object ' Outlook.Application
Dim objTask As Object ' Outlook.TaskItem
If (Not IsDate(strDate)) Or (strText = "") Or (DaysOut <= 0) Then
AddToTasks = False
GoTo ExitProc
End If
intDaysBack = DaysOut - (DaysOut * 2)
dteDate = CDate(strDate) + intDaysBack
On Error Resume Next
Set olApp = GetOutlookApp
On Error GoTo 0
If Not olApp Is Nothing Then
Set objTask = olApp.CreateItem(3) ' task item
With objTask
.StartDate = dteDate
.Subject = strText & ", Audit Start Date: " & strDate
.ReminderSet = True
.Recipients.Add = "you#mail.com"
.Save
.Assign
.Send
End With
Else
AddToTasks = False
GoTo ExitProc
End If
AddToTasks = True
ExitProc:
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
Set objTask = Nothing
End Function
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function

Answer 1

It seems you need to pass one more parameter to the function:
Option Explicit
Dim bWeStartedOutlook As Boolean
Function AddToTasks(strDate As String, strText As String, DaysOut As Integer, email as String) As Boolean
Dim intDaysBack As Integer
Dim dteDate As Date
Dim olApp As Object ' Outlook.Application
Dim objTask As Object ' Outlook.TaskItem
If (Not IsDate(strDate)) Or (strText = "") Or (DaysOut <= 0) Then
AddToTasks = False
GoTo ExitProc
End If
intDaysBack = DaysOut - (DaysOut * 2)
dteDate = CDate(strDate) + intDaysBack
On Error Resume Next
Set olApp = GetOutlookApp
On Error GoTo 0
If Not olApp Is Nothing Then
Set objTask = olApp.CreateItem(3) ' task item
With objTask
.StartDate = dteDate
.Subject = strText & ", Audit Start Date: " & strDate
.ReminderSet = True
.Recipients.Add(email)
.Recipients.ResolveAll()
.Save
.Assign
.Send
End With
Else
AddToTasks = False
GoTo ExitProc
End If
AddToTasks = True
ExitProc:
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
Set objTask = Nothing
End Function
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function