Port Ping not working but IP PING does work.

[WBURKERT]

The kine below does not execute and may be causing my macro from running. paping.exe works without a problem from a command prompt.

boolCode = objShell.Run("paping " & strWKB, 0, True)

This line executes and is similar to what I am trying to accomplish with paping.

'boolCode = objShell.Run("Ping -n 1 -w 6000 " & strComputer, 0, True)

unction GetPingInfo(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shell")

'paping [URL unfurl="true"]www.google.com[/URL] -p 80 -c 4

strPortNum = "8004"
'Checking program is not crashing here, that's all
MsgBox "strPortNum: value is " & strPortNum & vbCrLf, vbInformation

strWKB = strComputer & " -p  " & strPortNum & "  -c  1  -t  5000"

'Checking program is not crashing here, that's all
MsgBox "strWKB: value is " & strWKB & vbCrLf, vbInformation

'START paping routine

boolCode = objShell.Run("paping " & strWKB, 0, True)
MsgBox "boolCode: value is " & boolCode & vbCrLf, vbInformation

'START ping routine

'boolCode = objShell.Run("Ping -n 1 -w 6000 " & strComputer, 0, True)
'MsgBox "boolCode: value is " & boolCode & vbCrLf, vbInformation

    If boolCode = 0 Then
        GetPingInfo = "Successful Reply"
    Else
        GetPingInfo = "Failure"
    End If
End Function

 

[WBURKERT]

The following PAPING.EXE script is working but how can I get the port number from Column B? The worksheet layout is column A = computer name, column B is the port number and Column C is the IP Address. Column D is the current results.

Sub PingChecker()

Dim MySheet As Worksheet
Dim strIPColumn
Dim strPAColumn
Dim intRow
Dim strComputer
Dim strPortNum
Dim cell As Range
Dim strIPColumn1
Set MySheet = Application.ActiveSheet

strIPColumn = "C"

Columns(strIPColumn).Offset(0, 1).Select
Selection.Insert Shift:=xlToRight

'Replace(ActiveCell.Address(0, 0), ActiveCell.Row, "")
strIPColumn1 = Replace(ActiveCell.Address(0, 0), ActiveCell.Row, "")
Range("A1").Activate

'Ping the IP Addresses
For intRow = 1 To Cells(65536, strIPColumn).End(xlUp).Row
Cells(intRow, Asc(UCase(strIPColumn)) - 63).Value = GetPingInfoIP(Cells(intRow, strIPColumn).Value)
Next

Exit Sub

Application.ScreenUpdating = False

'Test Failure Action - CHANGE TO RED - just proof of concept for now
'Change Failures to Red Font and then move them over temporarily
On Error Resume Next
FindIt = "Failure"
Set rNa = ActiveSheet.UsedRange.Find(What:=FindIt, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)

'For Each Cell In Range(Whichever Column was chosen)
   Columns(strIPColumn1).Select
   For Each cell In Selection
   If cell.Font.ColorIndex = 3 Then
   cell.Copy
   cell.Offset(0, -1).PasteSpecial xlPasteValuesAndNumberFormats
   cell.Value = "Failure"
   cell.Font.ColorIndex = 1
   cell.Offset(1, 0).Activate
   End If
   Next

'Fit all columns
Cells.EntireColumn.AutoFit
Range("A1").Activate

'Deselect the last cell and hide the Display Status Bar
Application.CutCopyMode = False
Application.StatusBar = ""
Application.DisplayStatusBar = False
Application.ScreenUpdating = True

End Sub

Function GetPingInfoIP(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shell")

'paping command syntax
'paping [URL unfurl="true"]www.google.com[/URL] -p 80 -c 4

strPortNum = "8004"

'START paping routine

boolCode = objShell.Run("paping.exe " & strComputer & " -p " & strPortNum & " -c 1 -t 10000", 0, True)
'MsgBox "PAPING boolCode: value is " & boolCode & vbCrLf, vbInformation

    If boolCode = 0 Then
        GetPingInfoIP = "Successful Reply"
    Else
        GetPingInfoIP = "Failure"
    End If
End Function

 

[dilettante]

You want forum329.

You are not writing Visual Basic.