Excel VBA收件人添加基於相關單元格

Question

我使用此代碼（http://www.jpsoftwaretech.com/using-excel-vba-to-set-up-task-reminders-in-outlook/）並自己添加了strRecipient字段。我是一個完全的VBA noob，很顯然，這是行不通的。任何人都可以提供一個建議，我可以如何獲得一個收件人部分添加，自動反饋單元格A4例如？

感謝

Option Explicit 

Dim bWeStartedOutlook As Boolean 

Function AddToTasks(strDate As String, strText As String, DaysOut As Integer, strRecipient As String) As Boolean 
    ' Adds a task reminder to Outlook Tasks a specific number of days before the date specified 
    ' Returns TRUE if successful 
    ' Will not trigger OMG because no protected properties are accessed 
    ' by Jimmy Pena, http://www.jpsoftwaretech.com, 10/30/2008 
    ' 
    ' Usage: 
    ' =AddToTasks("12/31/2008", "Something to remember", 30) 
    ' or: 
    ' =AddToTasks(A1, A2, A3) 
    ' where A1 contains valid date, A2 contains task information, A3 contains number of days before A1 date to trigger task reminder 
    ' 
    ' can also be used in VBA : 
    'If AddToTasks("12/31/2008", "Christmas shopping", 30) Then 
    ' MsgBox "ok!" 
    'End If 

Dim intDaysBack As Integer 
Dim dteDate As Date 
Dim olApp As Object ' Outlook.Application 
Dim objTask As Object ' Outlook.TaskItem 

' make sure all fields were filled in 
If (Not IsDate(strDate)) Or (strText = "") Or (DaysOut <= 0) Or (strRecipient = "") Then 
    AddToTasks = False 
    GoTo ExitProc 
End If 

' We want the task reminder a certain number of days BEFORE the due date 
' ex: if DaysOut = 120, then we want the due date to be -120 before the date specified 
' we need to pass -120 to the NextBusinessDay function, so to go from 120 to -120, 
' we subtract double the number (240) from the number provided (120). 
' 120 - (120 * 2); 120 - 240 = -120 

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 & ", due on: " & strDate 
     .ReminderSet = True 
     .Recipients.Add = strRecipient 
     .Save 
     .Assign 
     .Send 
    End With 

Else 
    AddToTasks = False 
    GoTo ExitProc 
End If 

' if we got this far, it must have worked 
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

With objTask

strRecipient = Sheets("sheet name here").Range("A4").Value 

strRecipient = Sheets("sheet name here").Range("A4").Value 
With objTask 
    .startdate = dteDate 
    .CC = strRecipient 
    .Subject = strText & ", due on: " & strDate 
    .ReminderSet = True 
    .Save 
    .Assign 
    .Send 
End With