EXCEL/Network - a羅針盤

ここではExcelのマクロによるネットワーク関連の操作をするマクロをまとめてみました。

１．ping †

サーバーの稼働状況をチェックするのにpingをサーバーに送信して確認することがあります。Excelから確認できれば便利です。特にサーバーが複数台ありExcelのシートのリストから順番にチェックできればとても便利です。
VBAの命令にはpingがないためここではWMI(Windows Management Instrumentation Microsoft®)を使用します。
WMIが使用できない場合は、参照設定で「Microsoft WMI Scripting V1.2 Library」を設定してみて下さい。
次の関数のパラメータにホスト名またはIPアドレスを指定して使用します。

Function GetPingResult(Hostname As String) As String
   Dim objPing As Object
   Dim objStatus As Object
   Dim Result As String
   Dim wbemServices As Variant
   Dim TimeOut As Integer
   
   strComputer = "."    ' ドット (.) は WMI のローカル コンピュータを表します。
   TimeOut = 1

   Set wbemServices = GetObject("winmgmts:\\" & strComputer)

   Set objPing = wbemServices.ExecQuery("Select * From Win32_PingStatus " & _
        "Where ResolveAddressNames = True AND Buffersize = 1 AND Timeout = " & _
        TimeOut & " AND Address = '" & Hostname & "'")

   For Each objStatus In objPing
      Select Case objStatus.StatusCode
         Case 0: strResult = "Connected"   '成功した場合。これ以外はエラーです。
         Case 11001: strResult = "Buffer too small"
         Case 11002: strResult = "Destination net unreachable"
         Case 11003: strResult = "Destination host unreachable"
         Case 11004: strResult = "Destination protocol unreachable"
         Case 11005: strResult = "Destination port unreachable"
         Case 11006: strResult = "No resources"
         Case 11007: strResult = "Bad option"
         Case 11008: strResult = "Hardware error"
         Case 11009: strResult = "Packet too big"
         Case 11010: strResult = "Request timed out"
         Case 11011: strResult = "Bad request"
         Case 11012: strResult = "Bad route"
         Case 11013: strResult = "Time-To-Live (TTL) expired transit"
         Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
         Case 11015: strResult = "Parameter problem"
         Case 11016: strResult = "Source quench"
         Case 11017: strResult = "Option too big"
         Case 11018: strResult = "Bad destination"
         Case 11032: strResult = "Negotiating IPSEC"
         Case 11050: strResult = "General failure"
         Case Else: strResult = "Unknown host"
      End Select
      GetPingResult = strResult
   Next

   Set wbemServices = Nothing
   Set objPing = Nothing

End Function

EXCEL Top

Last-modified: 2014-07-29 (火) 03:39:33 (3719d)