Sub Click(Source As Button)

     ' --- Excelオブジェクト作成
     Set excelObj = CreateObject("Excel.application") 
     
     ' --- ExcelオブジェクトからWindowsバージョンを取得
     Dim osVersion As Variant
     osVersion = excelObj.Application.OperatingSystem
     
     ' --- Windows Scripting Hostオブジェクト作成
     Dim wshObj As Variant 
     Set wshObj = CreateObject("WScript.Network") 
     Dim shObj As Variant 
     Set shObj = CreateObject("WScript.shell") 
     
     Dim prtName As String, prtPort As String, prtSpool As String, tmpStr As String
     Dim intX As Long
     
     ' --- プリンター情報を取得し表示
     msgTitle = "Printer Information"
     Set printer = wshObj.EnumPrinterConnections()
     Dim i As Integer
     i = 0
     Do While i < printer.length          ' ループ実行前に i の値を検証
          prtName = printer.Item(i+1)
          prtPort = printer.Item(i)
          ' --- ↓WindowsME、98、95
          If  osVersion = "Windows (32-bit) 4.90"_
          Or osVersion = "Windows (32-bit) 4.10"_
          Or osVersion = "Windows (32-bit) 4.00" Then
               tmpStr = shObj.RegRead("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Print\Printers\" & prtName & "\Port")
          ' --- ↓Windows2000以降
          Else               
               tmpStr = shObj.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Devices\" & prtName)
          End If
          intX = Instr(1, tmpStr$, ",")
          prtSpool = Right(tmpStr$, Len(tmpStr$) - intX)  
          Msgbox prtName & Chr(13) & prtPort & Chr(13) & prtSpool, vbInformation, msgTitle
          i = i + 2
     Loop
     
End Sub