CODEWITHSUNDEEP
excelvbaemailoutlook
ken_you_not
ken_you_not

Reputation: 93

Sending email based on cell values

Is there a more efficient way to send email reminders based on a cell value that changes frequently?

'This is the main function

Sub notify()          
 Dim rng As Range
 For Each rng In Range("F3:F14")
    If (rng.Value = 1) Then
        Call mymacro
    End If
 Next rng
  
End Sub
'-----------------------------------------------------------------------

  'This is the function that sends an email when called by the main function

  Private Sub mymacro()  
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "email address"
        .CC = ""
        .BCC = ""
        .Subject = "test succeeded"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Both codes are in the same module of my worksheet. The code sends an email (through Outlook) to the user. For example, if F3 and F7 evaluate to true, two emails will be sent to the user.

How can I, if the same situation occurs (F3 and F7 evaluate to true), the two email sent to the user would specify which cell evaluated to true. In other words, each email sent would be different in pointing out which specific cell evaluated to true.

Also, would the code be able to rerun if the data inside the cell ("F3:F14") is updated?

Upvotes: 2

Views: 10655

Answers (1)

pokemon_Man
pokemon_Man

Reputation: 902

On refresh of query, the code should check each cell from F3 to F14 and see if it is equal to 1, if so, it will email user the cell location.

UPDATE:

'Need to be in the sheet code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Call notify
End Sub

Sub notify()
    Dim rng As Range
    For Each rng In Range("F3:F14")
       If (rng.Value = 1) Then
           Call mymacro(rng.Address)
       End If
    Next rng
End Sub

Private Sub mymacro(theValue As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "The value that changed is in cell: " & theValue
    On Error Resume Next
    With xOutMail
        .To = "email address"
        .CC = ""
        .BCC = ""
        .Subject = "test succeeded"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Upvotes: 1

Related Questions