Получить список модемов

Option Explicit
 
Sub bbb_модемы()
 
    Dim objWMIService As Object
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
    Dim colItems As Object
    Set colItems = objWMIService.ExecQuery("Select * from Win32_POTSModem")
 
    Dim Comm1 As MSComm
 
    If Comm1 Is Nothing Then
        MsgBox "Переменный 'Comm1' пустой, аднака.", vbExclamation, "Думайте"
        Exit Sub
    Else
        'пробуем назначить порт с которым будем работать
        Comm1.CommPort = 3
    End If
 
End Sub

Dim Comm1 As New MSComm

'защищает от некоторых, трудно уловимых ошибок
'Option - Вариант
'Explicit - Явный
Option Explicit
 
Sub Все_модемы()
  
    Dim objWMIService As Object
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
    Dim colItems As Object
    Set colItems = objWMIService.ExecQuery("Select * from Win32_POTSModem")
 
    Dim objItem As Object
 
    Dim Количество_модемов As Long
    Dim NumberPort As String
    Dim Результат As String
    Dim Ответ_модема As String
    Dim Comm1 As New MSComm
    Dim i As Long
 
    For Each objItem In colItems
        'имя порта
        MsgBox$ objItem.AttachedTo
        'имя порта без первых трёх букв
        MsgBox$ Right$(objItem.AttachedTo, (Len(objItem.AttachedTo) - 3))
        NumberPort = Right$(objItem.AttachedTo, (Len(objItem.AttachedTo) - 3))
        MsgBox$ NumberPort
        'назначаем порт с которым будем работать
        'Функция CLng(Conversion to Long) используется для приведения выражения в тип Long
        Comm1.CommPort = CLng(NumberPort)
        'если преобразовываемый тип данных String,тогда он должен быть числом
        'иначе возникает ошибка стадии выполнения - 13 (Type mismasth)
        'делаем установки элемента управления MS Comm
        Comm1.Settings = "9600,N,8,1"
        'используем весь буфер
        Comm1.InputLen = 0
        'открываем порт
        Comm1.PortOpen = True
        'посылаем команду модему
        Comm1.Output = "AT" + Chr$(13)
        'ожидаем возврата данных, задержка тут ламерская, но чисто что бы показать работу
        Do
            i = i + 1
            DoEvents
        Loop Until i = 1000000 Or Comm1.InBufferCount >= 2
        'читаем ответ "ОК" в последовательном порту
        Ответ_модема = Comm1.Input
        'закрываем порт
        Comm1.PortOpen = False
 
        Количество_модемов = Количество_модемов + 1
 
        If Len(Ответ_модема) <> 0 Then
            Результат = Результат & Количество_модемов & " " & objItem.Model & " - " & objItem.AttachedTo & " - " & Ответ_модема & vbCrLf
        Else
            Результат = Результат & Количество_модемов & " " & objItem.Model & " - " & objItem.AttachedTo & " - Ответ модема не ОК" & vbCrLf
        End If
  
        If Err.Number <> 0 Then
            MsgBox$ Err.Number & "-" & Err.Description
            Err.Number = 0
            'или Err.Clear - обнуляем ошибку
        End If
    Next
 
    MsgBox$ "Количество модемов: " & Количество_модемов & vbCrLf & Результат
 
    Selection.EndKey Unit:=wdStory
    Selection.TypeText Text:="Количество модемов: " & Количество_модемов & vbCrLf & Результат
 
End Sub

Option Explicit
 
Sub aКоличество_модемов_все_модемы()
 
    Dim WMI As Object
    Set WMI = GetObject("winmgmts:\\.\root\cimv2")
 
    Dim myCollection As Object
    Set myCollection = WMI.ExecQuery("Select * from Win32_POTSModem")
 
    Dim Количество_модемов As Long
    'Количество_модемов = myCollection.Count
 
    Dim Результат As String
    Dim Ответ_модема As String
 
    Dim objItem As Object
 
    'если выделяет "Comm As New MSComm" и сообщение User-defined type not defined
    'значит в Tools References... нужно поставить опцию у Microsoft Comm Control 6.0
    Dim Comm As New MSComm
 
    Dim NumberCommPort As Long
    Dim i As Long
 
    For Each objItem In myCollection
        'имя порта
        'MsgBox$ objItem.AttachedTo
        'имя порта без первых трёх букв
        'Mid$(String,Start,[Length])
        'MsgBox$ Mid$(objItem.AttachedTo, 4)
        'оператор для отлова ошибок, указывает, что при возникновении ошибки нужно переходить к следующей строке кода
        On Error Resume Next
        'Функция CLng(Expression) используется для приведения выражения в тип Long
        'Если Expression имеет тип данных String,то он должен быть числом,иначе возникает ошибка стадии выполнения Type mismasth
        NumberCommPort = CLng(Mid$(objItem.AttachedTo, 4))
        If Err.Number <> 0 Then
            MsgBox$ _
                    Err.Number & "-" & Err.Description, vbOKOnly, _
                               "Внимание"
            'перейти к метке с именем ...
            GoTo Конец
        End If
        'оператор для отлова ошибок, указывает, что при возникновении ошибки нужно переходить к следующей строке кода
        On Error Resume Next
        'назначаем порт с которым будем работать
        Comm.CommPort = NumberCommPort
        'делаем установки элемента управления MS Comm
        Comm.Settings = "9600,N,8,1"
        'используем весь буфер
        Comm.InputLen = 0
        'открываем порт
        Comm.PortOpen = True
        'посылаем команду модему
        Comm.Output = "AT" + Chr$(13)
        'ожидаем возврата данных, задержка тут ламерская, но чисто что бы показать работу
        Do
            i = i + 1
            DoEvents
        Loop Until i = 1000000 Or Comm.InBufferCount >= 2
        MsgBox$ "|"
        'читаем ответ "ОК" в последовательном порту
        Ответ_модема = Comm.Input
        'закрываем порт
        Comm.PortOpen = False
 
        Количество_модемов = Количество_модемов + 1
 
        If Len(Ответ_модема) <> 0 Then
            Результат = Результат & Количество_модемов & " " & objItem.Model & " - " & objItem.AttachedTo & " - " & Ответ_модема & vbCrLf
        Else
            Результат = Результат & Количество_модемов & " " & objItem.Model & " - " & objItem.AttachedTo & " - Ответ модема не ОК" & vbCrLf
        End If
 
    Next objItem
 
    MsgBox$ "Количество модемов: " & Количество_модемов & vbCrLf & Результат
 
    Selection.TypeText Text:="Количество модемов: " & Количество_модемов & vbCrLf & Результат
 
Конец:
 
    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set WMI = Nothing
    Set myCollection = Nothing
 
End Sub