Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Port Ping not working but IP PING does work.

Status
Not open for further replies.

WBURKERT

Technical User
May 28, 2010
73
The kine below does not execute and may be causing my macro from running. paping.exe works without a problem from a command prompt.
Code:
boolCode = objShell.Run("paping " & strWKB, 0, True)
This line executes and is similar to what I am trying to accomplish with paping.
Code:
'boolCode = objShell.Run("Ping -n 1 -w 6000 " & strComputer, 0, True)


Code:
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
 
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.
Code:
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top