CODEWITHSUNDEEP
vbaexcelexcel-2013
Zack E
Zack E

Reputation: 706

Sending Email based on name in a cell

I have looked through multiple posts to send an email if a value in a range of cells changes and adapted the code I found in those posts to suit my needs, but for some reason the email is not being sent when the value in any cell of the range defined changes, and I am a little lost at why. Any guidance is greatly appreciated. Please see code below (please note that for confidentiality purposes the emails and names are fake).

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 = "[email protected]"   '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

Upvotes: 0

Views: 312

Answers (1)

BigBen
BigBen

Reputation: 50162

I think you've intended to use the Worksheet_Change event but have Private Sub Workbook_Change... instead.

Additional issues:

  • For Each cell In RgCell should probably be For Each cell in RgSel, or For Each cell in Target - otherwise the code runs through each cell in C2:C100, and not just the cell(s) changed, or Target.
  • There is no need to Set RgSel = Nothing
  • With Set MItem = OutlookApp.CreateItem(0), you create an email message before you've checked If cell.Value = "Bob". Move this line within the If statement.
  • Set OutlookApp = Nothing should be outside the For Each loop, i.e. it should be done after you've finished looping.
  • On Error GoTo NX, and then NX: Resume Next, is equivalent to On Error Resume Next, which doesn't handle any errors, but rather ignores them.
  • You may be missing a closing End If, or it is not included in this snippet.

Upvotes: 1

Related Questions