根据单元格中的名称发送电子邮件

Question

我查看了多篇文章，以便在单元格范围内的值发生变化时发送电子邮件，并调整了我在这些文章中找到的代码以满足我的需要，但由于某种原因，当范围定义的任何单元格中的值都发生了变化，我有点迷失了原因。非常感谢任何指导。请参阅下面的代码（请注意，出于保密目的，电子邮件和姓名都是假的）。

Private Sub Workbook_Change(ByVal Target As Range)
'   Uses early binding
'   Requires a reference to the Outlook Object Library
    Dim RgSel As Range, RgCell As Range
    Dim OutlookApp As Object, MItem As Object
    Dim Subj As String, EmailAddr As String, Recipient As String
    Dim CustName As String, Msg As String
    Dim pEmail As String

    On Error GoTo NX

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set RgCell = Range("C2:C100")
    Set RgSel = Intersect(Target, RgCell)

    If Not RgSel Is Nothing Then
        Set OutlookApp = CreateObject("Outlook.Application")
        Set MItem = OutlookApp.CreateItem(0)
            For Each cell In RgCell
                If cell.Value = "Bob" Then                      'Fake Name for posting question
                    pEmail = "BobT@SomethingBlahBlahBlah.com"   'Fake email address used for posting question
                    CustName = cell.Offset(0, -1).Value
                    Subj = "***NEW ITEM ASSIGNED***" & " - " & UCase(CustName)
                    Recipient = "Bob T. Builder"                'Fake name for posting question
                    EmailAddr = pEmail

                '   Compose Message
                    Msg = "Dear, " & Recipient & vbCrLf & vbCrLf
                    Msg = Msg & "I have assigned " & CustName & "'s" & " item to you." & vbCrLf
                    Msg = Msg & "Please review the information in their customer folder in the L: Drive." & vbCrLf & vbCrLf
                    Msg = Msg & "Sincerely," & vbCrLf & vbCrLf & vbCrLf
                    Msg = Msg & "Bob's Boss" & vbCrLf           'Fake name for posting question
                    Msg = Msg & "Vice President"

                '   Create Mail Item and send
                    With MItem
                        .to = EmailAddr
                        .Subject = Subj
                        .body = Msg
                        .Save   'This will change to .send after testing is complete
                    End With
                    Set RgSel = Nothing
                    Set OutlookApp = Nothing
                    Set MItem = Nothing
                End If

            Next cell
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

NX:
    Resume Next
End Sub

Answer 1

我认为您打算使用 Worksheet_Change 事件，但改为使用 Private Sub Workbook_Change...。

其他问题：

For Each cell In RgCell 可能应该是 For Each cell in RgSel 或 For Each cell in Target - 否则代码会遍历 C2:C100 中的每个单元格，而不仅仅是更改的单元格，或 Target.
没有必要Set RgSel = Nothing
使用 Set MItem = OutlookApp.CreateItem(0)，您在检查 If cell.Value = "Bob" 之前创建了一封电子邮件 。将此行 移动到 If 语句中。

Set OutlookApp = Nothing 应该在循环 For Each 之外，即它应该在之后完成循环结束。

On Error GoTo NX，然后 NX: Resume Next，相当于 On Error Resume Next，它不处理任何错误，而是忽略它们。

您可能缺少结尾 End If，或者它未包含在此代码段中。

根据单元格中的名称发送电子邮件

Sending Email based on name in a cell

excel

vba

excel-2013