TÉLÉPHONER À PARTIR D'UN MODEM EN VB

Private Sub DialButton_Click()
On Error GoTo TraiteErreur
Select Case DialButton.BackColor
    Case &HC0FFC0
        If IsNull(Data1.Recordset.Fields("Tel")) = False Or Len((Data1.Recordset.Fields("Tel"))) > 9 Then
            DialButton.BackColor = &HFF&
            MSComm1.PortOpen = True
            ' Envoie la commande Attention au modem.
            
            MSComm1.Output = "AT &F E0 H0 Q0 V1 &D2" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT X4" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT #CLS=8 #VLS=4 #VRN=0" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "ATM2" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "ATDT" & Data1.Recordset.Fields("Tel") & ";" & vbCrLf ' Vérifie que
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                    If InStr(Buffer$, "NO DIALTONE") Then
                        Erreur 18
                        GoTo Coupe
                    End If
                
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT #CLS=8 #VLS=6 #VTD=3F,3F,3F" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "ATA" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "VCON" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT#VLS=6" & vbCr
                Do
                    DoEvents
                    If MSComm1.PortOpen = False Then Exit Sub
                    Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            
            MSComm1.Output = "AT#SPK=1,03,3" & vbCr
                Do
                    DoEvents
                        If MSComm1.PortOpen = False Then Exit Sub
                        Buffer$ = Buffer$ & MSComm1.Input
                Loop Until InStr(Buffer$, "OK" & vbCrLf)
            Buffer$ = ""
            DialButton.Enabled = True
        Else
            MSComm1.PortOpen = False
            DialEncours = False
        End If
    Case &HFF&
Coupe:
        DialButton.BackColor = &HC0FFC0
        MSComm1.PortOpen = False
End Select

Exit Sub

TraiteErreur:
    'Resume err
DialButton.BackColor = &HC0FFC0
Resume Next
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
DialEncours = False
Erreur 16
Exit Sub
End Sub