Messagerie automatique dans VB

Résolu
Signaler
Messages postés
7
Date d'inscription
mardi 22 février 2005
Statut
Membre
Dernière intervention
28 mars 2008
-
Messages postés
1
Date d'inscription
dimanche 22 août 2004
Statut
Membre
Dernière intervention
14 mai 2008
-
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

3 réponses

Messages postés
7
Date d'inscription
mardi 22 février 2005
Statut
Membre
Dernière intervention
28 mars 2008

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. )
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
bonjour

Peut-être la bibliothèque MAPI
Messages postés
1
Date d'inscription
dimanche 22 août 2004
Statut
Membre
Dernière intervention
14 mai 2008

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