vbscript PAPING - Ping to an IP Port Number

[WBURKERT]

I have this vbscript working but don't seem to know how to get the port number passed into the Function GetPingInfoIP(strComputer). The worksheet layout is Column A is an administrative entry, Column B is the Port Number, Column C is the IP address and Column D is the results and is shifted right with each run of the macro. The vbscript currently reads the IP address and uses a fixed port number, just for testing, but I would like to know how to have the script read both the IP address and Port Number. I am sure it is something quick for anyone who has done this more than once and with a solution this vbscript could be useful for others. Thanks in advance.

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

 

[Geates]

I don't see where [tt]strComputer[/tt] is assigned.

-Geates

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm

 

[Geates]

oh wait, yes I do.

I'm not really familiar with spreadsheet macros but I would imagine it's ...

...
Cells(intRow, Asc(UCase(strIPColumn)) - 63).Value = GetPingInfoIP(Cells(intRow, strIPColumn).Value, [highlight #FCE94F]Cells(intRow, strIPColumn - 1).Value[/highlight])
...

Function GetPingInfoIP(strComputer, [highlight #FCE94F]strPortNum[/highlight])
   ...
   [s]strPortNum = "8004"[/s]
   ...
End Function

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm