Отправка электронной почты на основе имени в ячейке

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, или оно не включено в этот фрагмент.