Si vous voulez un example regarder la capture d'écran
Le code est pas compliké, y a aussi une bonne gestion de la barre de progression(lettres apres lettres)
Pour l'instant on peut envoyer qu'à une personne
Source / Exemple :
dans le module
------------------
Option Explicit
Public Type Retour
valeur As Boolean
libelle As String
End Type
Public Function Vérification_Champs() As Retour
Dim temp As Retour
temp.valeur = False
If F.Text_Serveur.Text = "" Then temp.libelle = "Vous devez remplir le champ [Serveur]": Vérification_Champs = temp: Exit Function
If F.Text_Mail_Dest.Text = "" Then temp.libelle = "Vous devez remplir le champ du [Mail Destinataire]": Vérification_Champs = temp: Exit Function
temp.valeur = True
Vérification_Champs = temp
End Function
Public Function Recup(ByVal temp As String, code As Integer) As Boolean
If Val(Mid(temp, 1, 3)) = code Then
Recup = True
Else
Recup = False
End If
End Function
Dans la frame
-----------------
Dim Etape As Integer
Dim Erreur As Boolean
Private Sub Command1_Click()
Dim ret
Dim temp As Retour
Erreur = False
MousePointer = fmMousePointerAppStarting
temp = Vérification_Champs
If temp.valeur = False Then 'Erreur
ret = MsgBox(temp.libelle, vbCritical, "Erreur")
MousePointer = fmMousePointerDefault
Else 'On met en forme les données
Etape = 0
If Not W.State = 0 Then W.Close
DoEvents
W.RemoteHost = Text_Serveur.Text
W.Connect
End If
End Sub
Private Sub Form_Load()
W.RemotePort = 25
W.LocalPort = 1003
Bar.max = 60
End Sub
Private Sub W_DataArrival(ByVal bytesTotal As Long)
Dim Temp_Recep, Temp_Envoi As String
Dim ret
W.GetData Temp_Recep, vbString
Select Case Etape
Case 0
If Recup(Temp_Recep, 220) Then
'''''''''''' Recup du nom du serveur pour la commande "HELO {Nom du serveur}"
Temp_Envoi = "HELO " & Text_Serveur
Envoyer (Temp_Envoi)
Else
MsgBox ("Problème lors de la Connexion" & vbCrLf & Temp_Recep)
MousePointer = fmMousePointerDefault
End If
Case 1 'On est connecté et on a envoyer "HELO {Nom du serveur}"
If Recup(Temp_Recep, 250) Then
'''''''''''' Le Helo est bien pris en compte et on peux commencer à envoyer...
Temp_Envoi = "MAIL FROM: " & "<" & Text_Mail_Emet & ">"
Envoyer (Temp_Envoi)
Else
'''''''''''' Le HELO est rejeté
MsgBox ("Problème lors de la réponse au HELO" & vbCrLf & Temp_Recep)
MousePointer = fmMousePointerDefault
End If
Case 2
If Recup(Temp_Recep, 250) Then
'''''''''''' Le MAIL FROM: est accepté
Temp_Envoi = "RCPT TO: " & "<" & Text_Mail_Dest & ">"
Envoyer (Temp_Envoi)
Else
'''''''''''' Le MAIL FROM: n'est pas accepté
MsgBox ("Problème lors de la réponse au MAIL FROM" & vbCrLf & Temp_Recep)
MousePointer = fmMousePointerDefault
End If
Case 3
If Recup(Temp_Recep, 250) Then
'''''''''''' Le RCPT est accepté, on a fait le plus dur ;)
Temp_Envoi = "DATA"
Envoyer (Temp_Envoi)
Else
'''''''''''' Le serveur n'est pas open relay ou alors le destinataire est inconnu
MsgBox ("Problème lors de la réponse au RCPT TO" & vbCrLf & Temp_Recep)
MousePointer = fmMousePointerDefault
End If
Case 4
If Recup(Temp_Recep, 354) Then
Temp_Envoi = ""
'''''''''''' Remplir les champs correspondant à l'emetteur
If Not Text_Nom_Emet = "" Or Not Text_Mail_Emet = "" Then
Temp_Envoi = "From: "
If Not Text_Nom_Emet = "" Then Temp_Envoi = Temp_Envoi & Chr(34) & Text_Nom_Emet & Chr(34) & " "
If Not Text_Mail_Emet = "" Then Temp_Envoi = Temp_Envoi & "<" & Text_Mail_Emet & ">"
Temp_Envoi = Temp_Envoi & vbCrLf
End If
''''''''''' Remplir les champs correspondant au destinataire
Temp_Envoi = Temp_Envoi & "To: "
If Not Text_Nom_Dest = "" Then Temp_Envoi = Temp_Envoi & Chr(34) & Text_Nom_Dest & Chr(34) & " "
Temp_Envoi = Temp_Envoi & "<" & Text_Mail_Dest & ">" & vbCrLf
''''''''''' Ajouter le sujet du mail
Temp_Envoi = Temp_Envoi & "Subject: " & Text_Sujet & vbCrLf & vbCrLf '2 sauts de lignes pour dire que l'on passe au corps du msg
''''''''''' Ajouter le corps du message
Temp_Envoi = Temp_Envoi & Text_Msg & vbCrLf & "."
''''''''''' On Envoie tout
Envoyer (Temp_Envoi)
Else
MsgBox ("Problème lors de la réponse au DATA" & vbCrLf & Temp_Recep)
MousePointer = fmMousePointerDefault
End If
Case 5
If Not Recup(Temp_Recep, 250) Then
''''''' Si pb lors de la fin du message
MsgBox ("Problème lors de la fin du corps du message" & vbCrLf & Temp_Recep)
MousePointer = fmMousePointerDefault
Else
''''''' Le message a bien été envoyé ;) C po cool ca?
End If
Envoyer ("QUIT")
Case 6
If Recup(Temp_Recep, 221) Then
If Not Erreur Then ret = MsgBox("Merci pour ce gentil programme" & vbCrLf & "qui m'a permis d'envoyer un" & vbCrLf & "E-mail @nonyme ;)", vbInformation, "Fin")
Else
MsgBox ("Problème lors de la déconnexion du serveur" & vbCrLf & Temp_Recep)
End If
Etape = -1
W.Close
MousePointer = fmMousePointerDefault
End Select
Etape = Etape + 1
End Sub
Private Sub W_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox (Description)
If W.State = 7 Then
''''''' Pour pas avoir le message MErci pour ce gentil prog....
Erreur = True
Envoyer ("quit")
DoEvents
Etape = 6
Else
W.Close
End If
MousePointer = fmMousePointerDefault
End Sub
Public Function Envoyer(temp As String)
Dim i, max, max_bar, comp_bar, delta_bar
''''''''''' on envoi les lettres une à une et en mm temps on fait progresser la barre1
max = Len(temp)
Bar.Value = Etape * 10
delta_bar = 10 / Len(temp)
For i = 1 To max Step 1
W.SendData (Mid(temp, i, 1))
Bar.Value = Bar.Value + delta_bar
Next i
W.SendData (vbCrLf)
End Function
Conclusion :
pour envoyer un mail:
-vous devez au moins remplir le champ serveur et l'adresse du destinataire
-le serveur SMTP doit etre celui qu'utilise le destinataire (pour bidule@wandoo.fr utiliser le serveur de wanadoo: mail.wanadoo.fr) ou alors un serveur "open relay" (c'est deja plus dur à trouver)
Je me suis pas renseigné assez mais pour ma part le serveur SMTP de monfournisseur me permet d'envoyer des mails à n'importe quels e-mail... Testez avec le votre...
Si vous avez d'autres questions ou peut etre des suggestions envoyer moi un message
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.