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中的每个单元格，而不仅仅是更改的单元格，或{ {1}}。
无需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，或者它未包含在此代码段中。

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

1 个答案: