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

EXCEL VBA代码需要额外的电子邮件消息代码

1 个答案: