Sub FIO()

Dim Zapros As String
Zapros = "89028912680"

OtvetRing Zapros

End Sub

MSComm1.CommPort =  30 

Dim Порт As String
    Порт = "COM3"
    MSComm1.CommPort = Порт

Function OtvetRing(Zapros As String) As String

'AT команды модема - http://v90.kiev.ua/articles/at_commands.html

    Dim MSComm1 As MSComm
    Set MSComm1 = New MSComm
    'ATD - Набор номера
    'Т Тоновый набор (то есть ATDT 3451798)
    'P Импульсный набор (то есть ATDP 2627506)
    Zapros = "ATD" & Zapros & ";"
    Dim dummy
    Dim ltime
    Dim FromModem As String

    'Имя порта
    'Панель управления Телефон и модем, вкладка Модем
    'Модем - PCI SoftV92 Data Fax Modem Подключен к - COM3
    'его надо опросить и получить ответ Успешно
    'в этом случае модем готов к работе

    MSComm1.CommPort =  3 
    MSComm1.PortOpen = True

    If Not (Zapros = "") Then
        'здесь уже звонит
        'как сделать проверку снята ли трубка телефона и вывести сообщение
        MSComm1.Output = Zapros & vbCr
    End If

    MSComm1.InBufferCount =  0 
    ltime = Timer()
    Do
        dummy = DoEvents()
        If MSComm1.InBufferCount Then
            FromModem = FromModem + MSComm1.Input

            If InStr(FromModem, "OK") Then
                'OK (0) Модем успешно выполнил команду
                OtvetRing = "OK"
                Exit Do
            ElseIf InStr(FromModem, "BUSY") Then
                'BUSY (7) Номер (канал) занят
                OtvetRing = "BUSY"
                Exit Do
            ElseIf InStr(FromModem, "NO CARRIER") Then
                'NO CARRIER (3) Модем потерял несущую или не получил ответ от удаленного модема
                OtvetRing = "NO CARRIER"
                Exit Do
            End If
        End If
    Loop

    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set MSComm1 = Nothing

End Function

MSComm1.PortOpen = True

  MSComm1.Output = "ATH1" & ";" & vbCr
    If FromModem + MSComm1.Input Like "*ERROR*" Then
        OtvetRing = "Снимите трубку, затем повторите вызов"
        GoTo Конец
    End If