Envoyer un e-mail autonome (sans mapi) *-

Commenter

Contenu du snippet

Bien le bonjour !
Voici un petit code pour envoyer des e-mails sans MAPI, la seule contrainte du code est que l'ordi doit être connecté, c'est tout.
Ce code est à mettre dans un module, la fonction Envoyer retourne TRUE si l'e-mail a été envoyé, FALSE si non. Vous devez passer en (premier) parametre un control Winsock.
Le dernier parametre est votre serveur mail de courrier sortant (SMTP), vous pouvez jeter un coup d'oeuil a la fin pour en avoir une liste de libres.
Le code ayant été très peu testé, il peut y avoir des erreurs, merci de les signaler, ou de les réparer sans grogner.
Bon dévellopement, et merci à VBCS.

Source / Exemple : 


Option Explicit
Dim Sock As Winsock

Function Envoyer(Socket As Winsock, Nom_Exped As String, Mail_Exped As String, Nom_Destin As String, Mail_Destin As String, Objet As String, Optional Sujet As String = "", Optional Serveur As String = "Serveur Par Defaut") As Boolean
Envoyer = False
Set Sock = Socket
Sock.Close
Sock.RemotePort = 25
Sock.RemoteHost = Serveur
Dim T(6) As String
Dim mFrom As String
Dim mTo As String
Dim mMess As String
mFrom = Nom_Exped & " " & "<" & Mail_Exped & ">"
mTo = Nom_Destin & " " & "<" & Mail_Destin & ">"
mMess = ""
mMess = "FROM: " & mFrom & vbCrLf & "TO: " & mTo & vbCrLf
If Sujet <> "" Then mMess = mMess & "SUBJECT:" & Sujet & vbCrLf & VbCrLf
mMess = mMess & Objet & vbCrLf
T(0) = "HELO " & Serveur & vbCrLf
T(1) = "MAIL FROM: " & "<" & Mail_Exped & ">" & vbCrLf
T(2) = "RCPT TO: " & "<" & Mail_Destin & ">" & vbCrLf
T(3) = "DATA" & vbCrLf
T(4) = mMess
T(5) = VbCrLf & "." & vbCrLf
T(6) = "QUIT" & vbCrLf
Dim i As Integer, c As Integer
Sock.Close
Sock.Connect
For c = 1 To 10
For i = 1 To 5000
DoEvents
Next i
DoEvents
If Sock.State = sckConnected Then Exit For
Next c
If Sock.State <> sckConnected Then Envoyer = False: Exit Function
For i = 0 To 6
DoEvents
If Not SdTxt(T(i)) Then
Exit For
Err.Number = 1
End If
Next i
If Err.Number = 0 Then Envoyer = True
End Function

Function SdTxt(txt As String) As Boolean
SdTxt = False
Dim i As Integer
Dim tmp As String * 1
For i = 1 To Len(txt)
tmp = Mid$(txt, i, 1)
Sock.SendData tmp
Next i
If Err.Number = 0 Then SdTxt = True
End Function

Conclusion :


J'ai apporté 2 petites rectifications. j'espère que ça marchera mieux maintenant.
----------------------
Bon, on m'a demandé un exemple et des serveurs libres (difficiles a trouver d'ailleurs, alors si vous en avez, mailez-les moi svp...).
  • Liste de serveurs:

- mail.mageos.com
  • Exemple:

Vous mettez dans une feuille de nom "Form1" un controle WInsock de Nom "Sock1".
Propriétés du message:
Exepediteur: Nom: Jean | Mail: Jean@piu.com
Destinataire: Nom: Pierre | Mail: Pierre@yoa.com
Sujet: "Salut c'est Jean..."
Objet: "Ca va ? Je voulais te dire que ma grand-mére était championne de Karate-Do poids lourd, c'est tout... Ciao."
Serveur: "mail.mageos.com"

Donc vous allez envoyer ça comme ça :

Envoyer Form1.Sock1, "Jean", "Jean@piu.com", "Pierre", "Pierre@yoa.com", "Ca va ? Je voulais te dire que ma grand-mére était championne de Karate-Do poids lourd, c'est tout... Ciao.", "Salut c'est Jean...", "mail.mageos.com"
... et c'est tout ! Pas dur quand même !

A voir également

S'inscrire maintenant

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.

Du même auteur (Bitored)