Pb d'envoi de mail avec winstock

Question

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

Voila mailez moi pour plus d'info
Merci a tout

PatriceVB · Answer

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.
@+

Pb d'envoi de mail avec winstock

1 réponse

Discussions similaires