'Written: May 26, 2008
'Author: Leith Ross
'Summary: Pings a IP adress a requested number of times with a specified
' time out interval. The functions returns a variant string array
' with results of the Ping command.
Function GetPingData(ByVal IP_Address As String, ByVal Ping_Count As
Integer, ByVal Timeout As Integer)
Dim CmdLine As String
Dim PingData As String
Dim PingReturn As Object
Dim WSH As Object
'Create the Cmd.exe command line string
CmdLine = "cmd.exe /c ping " & IP_Address & " -n " _
& CStr(Ping_Count) & " -w " & CStr(Timeout)
'Launch Cmd.exe and Ping the IP address
Set WSH = CreateObject("WScript.Shell")
Set PingReturn = WSH.Exec(CmdLine)
'Wait until the Ping process is finished
While PingReturn.Status = 0
DoEvents
Wend
'Remove Carraige Returns from the data
PingData = PingReturn.StdOut.ReadAll
PingData = Replace(PingData, vbCr, "")
'Split data into individual lines
GetPingData = Split(PingData, vbLf)
End Function
Sub PingAddresses()
Dim LastRow As Long
Dim N As Integer
Dim PingCount As Integer
Dim PingData As Variant
Dim R As Long
Dim StartCol As Variant
Dim StartRow As Long
Dim Timeout As Integer
PingCount = 4 'Number of time to ping the address
Timeout = 1000 'Milliseconds before timeout occurs
StartCol = "A" 'Starting column of IP addresses
StartRow = 2 'Starting row of IP addresses
'Calculate the number of lines to be returned
N = 8 + PingCount - 1
'Determine the row with the last IP address
LastRow = Cells(Rows.Count, StartCol).End(xlUp).Row
For R = StartRow To LastRow
'Trap error if there was no response
PingData = GetPingData(Cells(R, StartCol), PingCount, Timeout)
On Error Resume Next
Cells(R, StartCol).Offset(0, 1) = PingData(N)
If Err.Number <> 0 Then
Cells(R, StartCol).Offset(0, 1) = PingData(N - 2)
Err.Clear
End If
On Error GoTo 0
Next R
End Sub
2009/1/8 anak jalanan <[email protected]>
> Dear all pakar XL,
> Mau tanya nich, ada yang bisa kasih macro untuk nge-check IP address?
> Fungsinya persis kayak "ping" di command prompt....
>
> Wassalam
> Thanks B4
>
> FIKAR
>
>
>
