Messagerie automatique dans VBRésolu

Question

Bonjour,     je voudrais savoir quel objet / librairie utiliser pour crée et envoyer un mail dans une application VB6. (bien entendu j'ai bien fait des tests avec mapiCession, mais je ne veux pas que mon code utiliser et exécute le client messagerie de l'utilisateur).. Une idée ? une solution ? merci par avance

cs_bob35 · Accepted Answer

Merci pour la réponse, mais j'ai aussi essayé et je ne suis pas arrivé à mes fins avec MAPI. Par contre j'ai trouvé hier ma solution et je l'ai intégré à mon projet (moyennant quelques modifications et amélioration de fonction), et ca marche du feu de dieu !! je pense qu'une fois bien testé, je posterais le code source. Tout simplement sur la base d'un objet CDO en manipulant le serveur SMTP en fonction des paramètres de connection. Le plus pour moi dans cette fonction, c'est la compatibilité VB6 !! 
Merci à tous, sujet résolu. 
Code source très bientot ( je précise que 80% du code n'est pas de moi, mais je pense que ca intéressera pas mal de codeurs. )

cs_loulou69 · Answer

bonjour 

Peut-être la bibliothèque MAPI

jonpa · Answer

Voici un petit code pour se passer de Outlook et de MAPI Il faut ajouter un WinSock sur la feuille Private Enum SMTPSessionState SMTP_CONNECT SMTP_HELO SMTP_MAIL SMTP_RCPT SMTP_DATA SMTP_SENDMESSAGE SMTP_QUIT End Enum Private CurrentSMTPSessionState As SMTPSessionState Private lcSenderDisplayName As String ' Copie locale Private lcSenderAddress As String ' Copie locale Private lcRecipientDisplayName As String ' Copie locale Private lcRecipientAddress As String ' Copie locale Private lcSubject As String ' Copie locale Private lcMessage As String ' Copie locale Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim sServerResponse As String Dim sDataToSend As String Dim MessageLines() As String Dim i As Long ' Récupère la réponse du serveur Winsock1.GetData sServerResponse If Left(sServerResponse, 1) "2" Or Left(sServerResponse, 1) "3" Then Select Case CurrentSMTPSessionState Case SMTP_CONNECT ' Change l'état de la session CurrentSMTPSessionState = SMTP_HELO ' Récupère le nom de domaine sDataToSend = Right(lcSenderAddress, Len(lcSenderAddress) - InStr(lcSenderAddress, "@")) ' Envoie la commande HELO au serveur sDataToSend = "HELO " & sDataToSend & vbCrLf Winsock1.SendData sDataToSend Case SMTP_HELO ' Change l'état de la session CurrentSMTPSessionState = SMTP_MAIL ' Envoie la commande MAIL au serveur sDataToSend = "MAIL FROM:<" & lcSenderAddress & ">" & vbCrLf Winsock1.SendData sDataToSend Case SMTP_MAIL ' Change l'état de la session CurrentSMTPSessionState = SMTP_RCPT ' Envoie la commande RCPT au serveur sDataToSend = "RCPT TO:<" & lcRecipientAddress & ">" & vbCrLf Winsock1.SendData sDataToSend Case SMTP_RCPT ' Change l'état de la session CurrentSMTPSessionState = SMTP_DATA ' Envoie la commande DATA au serveur sDataToSend = "DATA" & vbCrLf Winsock1.SendData sDataToSend Case SMTP_DATA ' Change l'état de la session CurrentSMTPSessionState = SMTP_SENDMESSAGE ' Envoie les en-têtes du message Winsock1.SendData "Subject: " & lcSubject & vbLf Winsock1.SendData "From: " & Chr(34) & lcSenderDisplayName & Chr(34) & " <" & lcSenderAddress & ">" & vbLf Winsock1.SendData "To: " & Chr(34) & lcRecipientDisplayName & Chr(34) & " <" & lcRecipientAddress & ">" & vbLf ' Scinde le message en lignes MessageLines = Split(lcMessage, vbCrLf) ' Envoie chaque ligne du message For i = 0 To UBound(MessageLines) sDataToSend = MessageLines(i) If Left(sDataToSend, 1) = "." Then sDataToSend = "." & sDataToSend End If Winsock1.SendData sDataToSend & vbLf Next ' Envoie un point pour indiquer la fin de l'envoie des données Winsock1.SendData vbCrLf & "." & vbCrLf Case SMTP_SENDMESSAGE MsgBox "Le message envoyé avec succès.", vbInformation ' Change l'état de la session CurrentSMTPSessionState = SMTP_QUIT ' Envoie la commande QUIT au serveur Winsock1.SendData "QUIT" & vbCrLf Case SMTP_QUIT ' Ferme la connexion Winsock1.Close End Select Else MsgBox "Erreur SMTP : " & sServerResponse, vbExclamation CurrentSMTPSessionState = SMTP_QUIT Winsock1.SendData "QUIT" & vbCrLf End If End Sub Private Sub Winsock1_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 "Winsock Error number " & Number & " : " & Description, vbExclamation Winsock1.Close End Sub Public Sub SendMail(SMTPServeur As String, SenderAddress As String, RecipientAddress As String, Subject As String, Message As String, Optional SenderDisplayName As String, Optional RecipientDisplayName As String) lcSenderDisplayName = Trim(SenderDisplayName) lcSenderAddress = Trim(SenderAddress) lcRecipientDisplayName = Trim(RecipientDisplayName) lcRecipientAddress = Trim(RecipientAddress) lcSubject = Trim(Subject) lcMessage = Trim(Message) CurrentSMTPSessionState = SMTP_CONNECT Winsock1.Connect Trim$(SMTPServeur), 25 End Sub

Messagerie automatique dans VB

3 réponses

Votre réponse

Discussions similaires