COMポートリストを取得する | VBA

'*******************************************************************************
' COMポート処理
'*******************************************************************************

'*******************************************************************************
' COMポートの確認
'  input  : number  = COMポート番号 [1 - 256]
'  return : 0=OK / 1=NG
'  note   :
'*******************************************************************************
Function Check_ComPort(number As Integer) As Integer

    Dim i As Integer
    Dim cnt As Integer
    Dim result As Integer
    Dim List As Variant
    Dim Port As String
    Dim Message As String

    'COMポートリストの取得
    cnt = Get_ComPortList(List)
    If cnt = 0 Then
        MsgBox "このパソコンにはCOMポートがありません。"
        Check_ComPort = 1
        Exit Function
    End If

    result = 1
    Message = ""
    Port = "COM" & Format(number, "0")
    For i = 0 To cnt - 1
        If Port = List(i) Then
            result = 0
            Exit For
        End If

        If Message <> "" Then
            Message = Message & " , "
        End If
        Message = Message & List(i)
    Next

    If result <> 0 Then
        MsgBox "指定したCOMポートはありません。" & vbCrLf & _
               "下記の中から選択してください。" & vbCrLf & vbCrLf & _
               "    " & Message
    End If

    Check_ComPort = result

End Function


'*******************************************************************************
' COMポートリストの取得
'  input  : List    = [out] COMポート番号 (COMxxx)
'  return : COMポート数
'  note   :
'*******************************************************************************
Function Get_ComPortList(List As Variant) As Integer

    Dim Serial        As Object
    Dim SerialSet     As Object
    Dim objWMIService As Object
    Dim strComputer   As String
    Dim tmp As String

    Dim RegExp As Object
    Dim matches

    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.Pattern = "COM[0-9]+"

    strComputer = "."
    'WMIを呼び出す
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

    'PnPで登録されているもの（デバイスマネージャーで見えるもの）から
    'シリアルポートのクラスでかつ名前に「(COMxx)」と付いているものを抽出
    Set SerialSet = objWMIService.ExecQuery("Select * from Win32_PNPEntity Where " & _
                    "(ClassGuid = '{4D36E978-E325-11CE-BFC1-08002BE10318}') and " & _
                    "(Name like '%(COM%)')")

    'COMポート番号の取得
    tmp = ""
    For Each Serial In SerialSet
        If tmp <> "" Then
            tmp = tmp & ","
        End If

        Set matches = RegExp.Execute(Serial.Name)

        tmp = tmp + matches(0).Value
    Next

    List = Split(tmp, ",")

    Get_ComPortList = SerialSet.count

End Function