CODEWITHSUNDEEP
vbaexcelemail
Linda Alexis
Linda Alexis

Reputation: 1

Send e-mail dependant on specific cell contents

I am a novice VBA programmer and I have searched for this but am unable to find a solution that exactly matches what I need.

I have a code to ping out customer's IP address but I only need e-mail notifications for the pings that have timed out.

The ping results are in column D and the e-mails are in column E of my spreadsheet. I'd be grateful for any help.

Thanks in advance.

Dim OutlookApp
Dim objMail
Dim x As Long
Dim PingResults As range


lastrow = Sheets("Ping").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow

Set PingResults = range("d2:D250")
Set OutlookApp = CreateObject("Outlook.Application")
Set objMail = OutlookApp.CreateItem(olMailItem)

If PingResults.Cells.Value = "Request timed out." Then

objMail.To = Cells(x, 5).Value

With objMail
.Subject = Cells(x, 1) & " " & "-" & " " & Cells(x, 2) & " " & "-" & " " & Cells(x, 3)
.Body = "Run Diagnostics.  Customer's broadband appears to have issues" & vbCrLf & Cells(x, 4)
.Display
.Save
End With

SendKeys "%{s}", True

ElseIf PingResults.Cells.Value = "" Then


Set OutlookApp = Nothing
Set objMail = Nothing
End If
End Sub

Upvotes: 0

Views: 89

Answers (2)

CLR
CLR

Reputation: 12279

This should do it: 

Dim OutlookApp
Dim objMail
Dim x As Long
Dim PingResults As Range

Set OutlookApp = CreateObject("Outlook.Application")
lastrow = Sheets("Ping").Cells(Rows.Count, 1).End(xlUp).Row
Set PingResults = Range("d1:D" & lastrow)

For x = 2 To lastrow

    If PingResults.Cells(x, 1).Value = "Request timed out." Then
        Set objMail = OutlookApp.CreateItem(olMailItem)

        With objMail
            .To = Cells(x, 5).Value
            .Subject = Cells(x, 1) & " " & "-" & " " & Cells(x, 2) & " " & "-" & " " & Cells(x, 3)
            .Body = "Run Diagnostics.  Customer's broadband appears to have issues" & vbCrLf & Cells(x, 4)
            .Display
            .Save
        End With

        SendKeys "%{s}", True
        Set objMail = Nothing

    End If
Next x
Set OutlookApp = Nothing

Upvotes: 0

user3598756
user3598756

Reputation: 29421

you most probably are after this:

Option Explicit

Sub main()
    Dim pingResults As Range, cell As Range

    With Sheets("Ping")
        With .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
            .AutoFilter Field:=1, Criteria1:="Request timed out."
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set pingResults = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
        End With
        .AutoFilterMode = False
    End With

    If Not pingResults Is Nothing Then
        With CreateObject("Outlook.Application")
            For Each cell In pingResults
                With .CreateItem(0) '<--| olMailItem is an item of an OutLook enumeration whose value is "zero"
                    .Display
                    .to = cell.Offset(, 1).Value
                    .Subject = cell.Offset(, -3) & " " & "-" & " " & cell.Offset(, -2) & " " & "-" & " " & cell.Offset(, -1)
                    .Body = "Run Diagnostics.  Customer's broadband appears to have issues" & vbCrLf & cell.Value
                    .Save
                End With
                SendKeys "%{s}", True
            Next
            .Quit
        End With
    End If    
End Sub

Upvotes: 1

Related Questions