La première mise à disposition de ce source fut rejetée :
Source supprimée
Désolé, cette source a été supprimée pour les raisons suivantes :
- Soit ce n'etait pas une source
- Soit ce n'etait qu'une publicité
- Soit le zip ne comportait qu'un fichier .exe
- Soit le zip contenait un virus
- Soit cette source n'etait pas "correcte" Virus, Hack, Piratage etc...
- Soit cette source a été postée en double
Ou pour une autre bonne raison dans ce genre.
ALORS QUE RIEN DE TOUT CELA NE CORRESPOND..
Je tente une seconde fois
Source / Exemple :
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
Conclusion :
remplacer Data1.Recordset.Fields("Tel") par le numéro de téléphone désiré
DialButton sera le bouton de prise de ligne
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.