Ping IP Address From Command Button

[CharlesWhiteman]

Hi All, I've looked though all the associated posts on the site and googled but not as yet come up with an answer. Basically i want to ping an ip address from a command button in access (1st stage anyway)

I'm using this code to open the cmd window and ping an ip address but it only opens the window and does not do the ping

Shell ("C:\Windows\System32\cmd.exe /ping 192.168.1.100")

 

[HiTechCoach]

I would suggest the you write the command to a cmd file. Have the oput of the ping go to a file. You can use VBA code to read the results.

the cmd file would have something like:

ping 192.168.1.100 > c:\pingresults.txt

Would you like me to see if I can find an example?

 

[CharlesWhiteman]

Sure and thanks an example would be super.

 

[HiTechCoach]

I will see what I can dig up ...

 

[HiTechCoach]

Here is how to ping with the Shell.Exec method of the VBScript Windows Scripting Host and then parse the output in stdOut looking for the string "Reply". See code snippet below:

'Test stub
Sub TestPing()

    Dim strComputer As String
    strComputer = "<target computer>"
    If Not SystemOnline(strComputer) Then

        MsgBox "This computer is currently unreachable: " & strComputer, vbOKOnly, "Computer Status"
        '....your logic

    Else

        '...your logic
        MsgBox "This computer is Online!", vbOKOnly, "Computer Status"

    End If

End Sub 'TestPing

'Determine if system is online
Function SystemOnline(ByVal ComputerName As String)

    Dim oShell, oExec As Variant
    Dim strText,strCmd As String

    strText = ""
    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

Perhaps a more eloquent function for multiple connections (no command prompt boxes) is via a WMI method:

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

 

[CharlesWhiteman]

Thanks, that really useful and seems to work fine. Now I just need to get Access to capture the results but I will see if I can figure it out.

 

[Spyhunter]

i know this is a very old thread but how do i use this code, place on button, module?

please help - i need to ping some machines and display a message, etc

 

[CharlesWh]

Here's a copy of the code I used which is contained in the onclick event of a button.

Private Sub cmdTestIP_Click()
'On Error GoTo err_handler
Dim strComputer As String
    strComputer = Me.txtLocalIPtest
    If Not SystemOnline(strComputer) Then

'Display A Message
        MsgBox "Local IP Ping Test Failed: " & strComputer, vbOKOnly, "Failed"
'Record The Detail
            Dim strSql As String
            Dim strDate As String
            Dim strUser As String
            Dim strSupportID As String
            Dim StrCustID As String
            Dim strDetailNote As String

                strDate = Now()
                strUser = Forms.Frmsplashscreen.txtCurrentUser
                strSupportID = Forms.frmSupportNew.txtTblSupportID
                StrCustID = Forms.FrmCust.CustID
                strDetailNote = "Local IP " & " " & Me.txtLocalIPtest & " " & "Test Failed"

    strSql = "INSERT INTO TblSupportActivity(TblSupportID, CustID, DetailDate, DetailUser, DetailNote)"
    strSql = strSql & " VALUES('" & [strSupportID] & "', '" & [StrCustID] & "', '" & [strDate] & "', '" & [strUser] & "', '" & [strDetailNote] & "')"
DoCmd.SetWarnings False
        DoCmd.RunSQL strSql
   DoCmd.SetWarnings True
        Forms!frmSupportNew!lbSupportDetail.Requery
                  
    Else
                                DoCmd.SetWarnings False
        'Record The Detail
            Dim strSqlPassed As String
            Dim strDatePassed As String
            Dim strUserPassed As String
            Dim strSupportIDPassed As String
            Dim strCustIDPassed As String
            Dim strDetailNotePassed As String

                strDatePassed = Now()
                strUserPassed = Forms.Frmsplashscreen.txtUserName
                strSupportIDPassed = Forms.frmSupportNew.txtTblSupportID
                strCustIDPassed = Forms.FrmCust.CustID
                strDetailNotePassed = "Local IP " & " " & Me.txtLocalIPtest & " " & "Test Passed"

    strSqlPassed = "INSERT INTO TblSupportActivity(TblSupportID, CustID, DetailDate, DetailUser, DetailNote)"
    strSqlPassed = strSqlPassed & " VALUES('" & [strSupportIDPassed] & "', '" & [strCustIDPassed] & "', '" & [strDatePassed] & "', '" & [strUserPassed] & "', '" & [strDetailNotePassed] & "')"
DoCmd.SetWarnings False
        DoCmd.RunSQL strSqlPassed
DoCmd.SetWarnings True
        Forms!frmSupportNew!lbSupportDetail.Requery
        
        MsgBox "Local IP Test Successful", vbOKOnly, "Passed"

    End If
  DoCmd.SetWarnings True
  


End Sub

 

[CharlesWh]

To ping mulptiple machines you would have to write some loop into it. I'm thinking you could read ip addresses from a query maybe and then loop the code?

 

[Spyhunter]

Thanks for the above code errors on the following;

If Not SystemOnline(strComputer) Then

With error "Sub or function not defined"
(SystemOnline)

Any suggestions?

 

[Spyhunter]

any suggestions?

 

[JANR]

With error "Sub or function not defined"
(SystemOnline)

This indicate that you are missing a function/sub called SystemOnline in your code.

If you look carefully at post #5 By HiTechCoach You will find 2 variant's of this function, paste one of them in your module, and compile you code.

JR

 

[Spyhunter]

it did that, i have the first part in my click event to ping the computer and the rest in a module (labelled ping), but it errors now on the module -

Ambigouous name detected: SystemOnline

 

[Spyhunter]

found out what was causing it, i had two functions named the same. doh!

Just one thing now, I have got it working using a Click event, how can i link this to a timer (linked to a timer field user selection) and automatically go to the next record, etc etc I am using a Datasheet view, do i need to change this?

 

[Spyhunter]

thanks for your help. now all i need is to be able to check disk space and services on remote servers and report back to the form, much the same as the ping report (change colours of fields on form) Any suggestions for this?

 

[Spyhunter]

got it all working using WMI. thanks for your help.