Ping in VBA

اذا كنت تريد التأكد من وجود مجموعة من الاجهزة على الشبكة يمكنك تنفيذ الكود التالي. هذا على افتراض عدم وجود ما يمنع الاجهزة من الاتصال من جدار ناري او ما شابه. الكود يقوم بعمل دورة على كل الاجهزة الموجود في صفحة اكسيل حيث اسماء الاجهزة مكتوبة في العمود ايه

Sub TestPing()
Dim hostName As String
Cells(2, 1).Activate
While ActiveCell <> ""
hostName = ActiveCell.Value
If Not SystemOnline(hostName) Then
'تغيير لون الخلفية اذا كان الجهاز لا يستجيب
 ActiveCell.Interior.ColorIndex = 36
End If
ActiveCell.Offset(1, 0).Activate
Wend
End Sub 


Function SystemOnline(ByVal ComputerName As String)
Dim oShell, oExec As Variant
Dim strText, strCmd As String
' الاستعداد لسطر جديد
strText = ""
'تنفيذ الامر بنج 3 مرات حتى اذا كانت هناك مشكلة بالشبكة لا نعتمد على اجابة واحدة
strCmd = "ping -n 3 -w 1000 " & ComputerName
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec(strCmd)
Do While Not oExec.StdOut.AtEndOfStream
' قراءة ناتج الامر بنج
 strText = oExec.StdOut.ReadLine()

'اذا كان السطر لا يحوي كلمة ريبلاي فهذا يعنى وجود خطأ
 If InStr(strText, "Reply") > 0 Then
  SystemOnline = True
  Exit Do
 End If
Loop
End Function