Question

我是VBA新手程序员并且我已经搜索过这个但是找不到与我需要的完全匹配的解决方案。

我有一个代码来ping客户的IP地址，但我只需要有超时的ping的电子邮件通知。

ping结果位于D列，电子邮件位于我的电子表格的E列。我很感激任何帮助。

提前致谢。

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

Answer 1

你很可能在此之后：

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

Answer 2

这应该这样做：

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

根据特定的单元格内容发送电子邮件

2 个答案: