Solved ping tester ping multiple host

January 27, 2016 at 19:57:28
Specs: win7
hello
I want to write a batch file which will take input(ip address) from a column of excel sheet and ping that and will redirect the output to another column as reachable or unreachable.i want it to run continuously without disturbing the user to work on pc (without fluckring the black command screen)

See More: ping tester ping multiple host

Report •


✔ Best Answer
January 29, 2016 at 09:55:52
Here is the code, you will need to read it through and try to create the form as per my link above

or PM me your email address and I will send you my workbook.

MODULE CODE

Public StartMonitoring As Boolean

Function SystemOnline(ByVal ComputerName As String)

' This function returns True if the specified host could be pinged.
' HostName can be a computer name or IP address.
' The Win32_PingStatus class used in this function requires Windows XP or later.

' Standard housekeeping
Dim colPingResults As Variant
Dim oPingResult As Variant
Dim strQuery As String

' Define the WMI query
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & ComputerName & "'"

' Run the WMI query
Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
' Translate the query results to either True or False
For Each oPingResult In colPingResults

If Not IsObject(oPingResult) Then

SystemOnline = False
ElseIf oPingResult.StatusCode = 0 Then

SystemOnline = True
Else

SystemOnline = False

End If
Next

End Function


USERFORM CODE

Dim ObjExcel As Object
Dim URange, LRange
Dim BCell As Range
Dim OfflineCount As Integer, OnlineCount As Integer

Private Sub CommandButton2_Click()
StartCount
End Sub

Private Sub StartCount()
StartMonitoring = True
OnlineCount = 0
OfflineCount = 0

Label7.Caption = Time()

' Set ObjExcel = CreateObject("Excel.Application")
' Let ObjExcel.Visible = False

' ObjExcel.Workbooks.Open "P:\Team Asset Numbers.xlsx", , False

' Set URange = ObjExcel.Sheets("Sheet1").Range("B2")
' Set LRange = ObjExcel.Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp)

Set URange = Sheet1.Range("A1")
Set LRange = Sheet1.Range("A" & Rows.Count).End(xlUp)

Label6.Caption = LRange.Row - 1

Do While StartMonitoring = True

For Each BCell In Sheet1.Range(URange, LRange)

If SystemOnline(BCell) = True Then
OnlineCount = OnlineCount + 1
ListBox1.AddItem BCell.Offset(0, 1).Value
Label9.Caption = OnlineCount

Else

If SystemOnline(BCell) = False Then
OfflineCount = OfflineCount + 1
ListBox2.AddItem BCell.Offset(0, 1).Value
Label10.Caption = OfflineCount

End If
End If

DoEvents

Next BCell

StartMonitoring = False

Loop

' ObjExcel.DisplayAlerts = False
' ObjExcel.ActiveWorkbook.Close
' ObjExcel.Quit
' Set ObjExcel = Nothing

End Sub

Private Sub CommandButton3_Click()
StartMonitoring = False
Application.Visible = True
End Sub


Private Sub UserForm_Click()

End Sub



#1
January 28, 2016 at 02:26:59
Will a VBA solution be acceptable, i dont somethng similar at my work place to check how many computers were left on overnight when staff go home, wasnt my project i just wrote the code for them........

it would ping a list of ip addresses which are located on an excel spreadsheet, then return the status of that machine, ie online (reachable) offline (unreachable)

http://s13.postimg.org/np8npuz1z/Ca...


Report •

#2
January 28, 2016 at 07:34:52
Kindly post that code

Report •

#3
January 28, 2016 at 10:32:43
Kindly help me please

Report •

Related Solutions

#4
January 28, 2016 at 11:15:51
Joshi i am not in the office now so will post tomorrow

Report •

#5
January 29, 2016 at 05:20:53
Thnx waiting for the code sir

Report •

#6
January 29, 2016 at 07:47:15
I am waiting for you code desperately .

message edited by joshi868b


Report •

#7
January 29, 2016 at 09:55:52
✔ Best Answer
Here is the code, you will need to read it through and try to create the form as per my link above

or PM me your email address and I will send you my workbook.

MODULE CODE

Public StartMonitoring As Boolean

Function SystemOnline(ByVal ComputerName As String)

' This function returns True if the specified host could be pinged.
' HostName can be a computer name or IP address.
' The Win32_PingStatus class used in this function requires Windows XP or later.

' Standard housekeeping
Dim colPingResults As Variant
Dim oPingResult As Variant
Dim strQuery As String

' Define the WMI query
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & ComputerName & "'"

' Run the WMI query
Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
' Translate the query results to either True or False
For Each oPingResult In colPingResults

If Not IsObject(oPingResult) Then

SystemOnline = False
ElseIf oPingResult.StatusCode = 0 Then

SystemOnline = True
Else

SystemOnline = False

End If
Next

End Function


USERFORM CODE

Dim ObjExcel As Object
Dim URange, LRange
Dim BCell As Range
Dim OfflineCount As Integer, OnlineCount As Integer

Private Sub CommandButton2_Click()
StartCount
End Sub

Private Sub StartCount()
StartMonitoring = True
OnlineCount = 0
OfflineCount = 0

Label7.Caption = Time()

' Set ObjExcel = CreateObject("Excel.Application")
' Let ObjExcel.Visible = False

' ObjExcel.Workbooks.Open "P:\Team Asset Numbers.xlsx", , False

' Set URange = ObjExcel.Sheets("Sheet1").Range("B2")
' Set LRange = ObjExcel.Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp)

Set URange = Sheet1.Range("A1")
Set LRange = Sheet1.Range("A" & Rows.Count).End(xlUp)

Label6.Caption = LRange.Row - 1

Do While StartMonitoring = True

For Each BCell In Sheet1.Range(URange, LRange)

If SystemOnline(BCell) = True Then
OnlineCount = OnlineCount + 1
ListBox1.AddItem BCell.Offset(0, 1).Value
Label9.Caption = OnlineCount

Else

If SystemOnline(BCell) = False Then
OfflineCount = OfflineCount + 1
ListBox2.AddItem BCell.Offset(0, 1).Value
Label10.Caption = OfflineCount

End If
End If

DoEvents

Next BCell

StartMonitoring = False

Loop

' ObjExcel.DisplayAlerts = False
' ObjExcel.ActiveWorkbook.Close
' ObjExcel.Quit
' Set ObjExcel = Nothing

End Sub

Private Sub CommandButton3_Click()
StartMonitoring = False
Application.Visible = True
End Sub


Private Sub UserForm_Click()

End Sub


Report •

#8
January 29, 2016 at 10:44:46
My email is

Thnx very much

message edited by joshi868b


Report •

#9
January 29, 2016 at 10:47:51
Not a good idea to post your email address on a public forum, remove it asap unless you want spammers to have a field day.

I am out at the moment so will send you the workbook assoon as i can


Report •

#10
January 29, 2016 at 11:02:30
I think u noted down my email id
Kindly send me that workbook asap i desperately need that. I am very thankful to you .

Thnx once again


Report •

#11
January 29, 2016 at 23:27:41
Sir waiting for your mail

Report •

#12
January 30, 2016 at 05:51:22
Joshi,

I am unable to remote onto my work server for some reason, and that is where the workbook is, i will have to email it to you on Monday.


Report •

#13
January 31, 2016 at 19:22:17
Good morning kindly send me that workbook today
Thanx once again

Report •

#14
February 1, 2016 at 00:21:28
Morning Joshi,

i have sent you the workbook.


Report •

#15
February 5, 2016 at 10:18:28

Report •

Ask Question