Sylvainlefou
Messages postés43Date d'inscriptionvendredi 27 décembre 2002StatutMembreDernière intervention15 février 2006
-
28 déc. 2002 à 15:53
PatriceVB
Messages postés562Date d'inscriptiondimanche 16 décembre 2001StatutModérateurDernière intervention26 décembre 2007
-
29 déc. 2002 à 12:33
J'ai récuperer sur internet et bidouiller ce petit code qui devrait envoyer des mails mais il ne marche po :sad)
Le programme reste bloquer au 4° "waitfor" (apres
"Winsock1.SendData (Second)")
Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single
Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
On Error GoTo erreur
Winsock1.LocalPort = 0 'Définit le port à 0
If Winsock1.State = sckClosed Then
DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
Third = "Date:" + Chr(32) + DateNow + vbCrLf
Fourth = "From:" + Chr(32) + FromName + vbCrLf
Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
Seventh = EmailBodyOfMessage + vbCrLf
Ninth = "X-Mailer: VBUNK Sender v 1.0" + vbCrLf
Eighth = Fourth + Third + Ninth + Fifth + Sixth
Winsock1.Protocol = sckTCPProtocol
Winsock1.RemoteHost = MailServerName
Winsock1.RemotePort = 25
Winsock1.Connect
WaitFor ("220")
Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
WaitFor ("250")
Winsock1.SendData (first)
WaitFor ("250")
Winsock1.SendData (Second)
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)
WaitFor ("354")
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
WaitFor ("250")
Winsock1.SendData ("quit" + vbCrLf)
WaitFor ("221")
Winsock1.Close
End If
Exit Sub
erreur:
End Sub
Sub WaitFor(ResponseCode As String)
On Error Resume Next
Start = Timer
While Len(Response) = 0
Tmr = Start - Timer
DoEvents
If Tmr > 50 Then
MsgBox "Erreur SMTP"
Exit Sub
End If
Wend
While Left(Response, 3) <> ResponseCode
DoEvents
If Tmr > 50 Then
Exit Sub
End If
Wend
Response = ""
End Sub
Private Sub Command1_Click()
On Error Resume Next
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
Close
End Sub
Function SendMessage()
On Error Resume Next
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
End Function
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response
End Sub
PatriceVB
Messages postés562Date d'inscriptiondimanche 16 décembre 2001StatutModérateurDernière intervention26 décembre 2007 29 déc. 2002 à 12:33
Tu as tout un tas de sources sur le site qui envoie des mails et qui marchent. Prends exmple sur ceux-ci. Pour les chercher va dans la ribrique chercher en haut de la page, tae envoi mail et sélectione sources dans la liste déroulante.
@+