EXCEL VBA代碼需要額外的電子郵件信息代碼

Question

我是新來的編碼人員，並且在爲電子郵件提醒添加額外的電子郵件時遇到了一些問題。我發現的代碼是60/90天的電子郵件提醒，這兩個提醒都有一封電子郵件。我想將60天和90天的提醒路由到特定的電子郵件，而不是通用電子郵件，任何人都可以幫我解決問題嗎？

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 That 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 That 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 

Answer 1

編輯 - 這個編譯沒有任何錯誤：

Public Sub SendReminderNotices() 

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 wkbReminderList = ActiveWorkbook 
Set wksReminderList = ActiveWorkbook.ActiveSheet 

lngNumberOfRowsInReminders = _ 
      wksReminderList.Cells(Rows.Count, "A").End(xlUp).Row 

    For i = 2 To lngNumberOfRowsInReminders 

     If wksReminderList.Cells(i, 7) = "" And _ 
      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 

     ElseIf wksReminderList.Cells(i, 8) = "" And _ 
       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 

    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 

    Set OutApp = CreateObject("Outlook.Application") 
    OutApp.Session.Logon "Outlook" 
    Set OutMail = OutApp.CreateItem(0) 
    On Error GoTo ErrorOccurred 
    With OutMail 
     .To = strAddress 
     .Subject = strSubject 
     .Body = strBody 
     .Send 
    End With 

    SendAnOutlookEmail = True 

Continue: 
    On Error GoTo 0 
    Set OutMail = Nothing 
    Set OutApp = Nothing 
    Exit Function 

ErrorOccurred: 
    Resume Continue 
End Function