ACCESSでpingってみた

先ほどのはEXCELですが、実はVLOOKだとレコード重複とかあるんで
比較をACCESSでした方がいいことと、一々ACCESSテーブルをEXCELに
落としてpingして結果をインポートとかいう馬鹿げたことをしたくないので
ACCESSに先ほどのやつを移植。
短時間でやっているから、エラーチェックとか細かいのなしです。
まぁそんなに使わんしね。備忘録で

Private Sub コマンド1_Click()
    
    '参照URL：http://accessvba.pc-users.net/ado/move_record.html
    '       　http://www.moug.net/tech/acvba/0080026.html
    '
    
    Dim cn   As ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    Dim tblName As String
    Dim IpAddr As String
    Dim fieldSearch As String
    
    
    tblName = "t_diff"
    Set cn = CurrentProject.Connection
    
    rs.Open tblName, cn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rs.MoveFirst
    
    Dim objWSH As Object, oEx As Object
    Dim result As String
    Const msg = "ラウンド トリップの概算時間"
    
    Do Until rs.EOF
    
        IpAddr = rs![IPアドレス管理表]
        fieldSearch = "IPアドレス管理表=" & "'" & IpAddr & "'"
        
        cmd = "cmd.exe /c ping -n 1 " & IpAddr
        Set objWSH = CreateObject("WScript.Shell")
        Set oEx = objWSH.Exec(cmd)
                
        Do While oEx.Status = 0
            DoEvents
        Loop
        
        result = oEx.StdOut.ReadAll
        
        rs.Find (fieldSearch)
        If InStr(result, msg) = 0 Then
            rs![PING結果] = "PingNG"
            rs.Update
        Else
            rs![PING結果] = "PingOK"
            rs.Update
        End If
        
        
        Set objWSH = Nothing
        
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
    MsgBox ("ping打ち完了です!!")
    
    
End Sub