Question 2

Comment envoyer des e-mails ?

Il existe plusieurs solutions pour envoyer des e-mails à partir de Visual Basic, le choix de l'une ou l'autre solution dépendant essentiellement des besoins de votre application.

Cet article présente les méthodes les plus courantes, à savoir :

• Avec ShellExcute et commande mailto
• Avec les contrôle MAPIMessages et MAPISession
• Avec CDO
• Avec L'automation Outlook
• Avec les sockets, en implémentant POP3, SMTP, IMPA, etc.

Utilisation de ShellExecute et de la commande mailto

La première, et sans doute la plus simple, consiste à exécuter la commande "mailto:adresse@serveur.com" à l'aide de l'API ShellExecute. Cette solution est très limitée et nécessite l'intervention de l'utilisateur qui devra lui-même composer et envoyer l'e-mail :

Private Const SW_SHOWNORMAL = 1

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Form_Load()

    ShellExecute Me.hwnd, vbNullString, "mailto:adresse@serveur.com", vbNullString, "C:\", SW_SHOWNORMAL

End Sub

La syntaxe de mailto: est décrite dans la fiche : Q192341 OLEXP: How to Send Outlook Express Mail from a Command Line.

Utilisation des controles MAPIMessage et MAPISession

La deuxième solution consiste à employer les contrôles MAPISession et MAPIMessages qui permettent une gestion facile et complète de l'envoi et de la réception d'e-mails. Pour ce faire, ajoutez un contrôle MAPISession et un contrôle MAPIMessages sur votre form. Ajoutez ensuite le code suivant :

Private Sub Command1_Click()

    MAPISession1.SignOn
    MAPIMessages1.SessionID = MAPISession1.SessionID
    MAPIMessages1.Compose
    MAPIMessages1.RecipAddress = "adresse@serveur.com"
    MAPIMessages1.Send
    MAPISession1.SignOff

End Sub

Malheureusement, les contrôles MAPI nécessitent la présence sur le poste d'une application de messagerie gérant l'API MAPI (comme par exemple Outlook Express).

Utilisation de CDO

Vous pouvez aussi employer la technologie CDO qui est une interface permettant d'accéder à la couche MAPI. Un excellent technopoche est consacré à ce sujet et est disponible à l'adresse suivante : http://www.microsoft.com/france/msdn/support/technopoches/default.asp.

Utilisation de l'automation Outlook

Si votre application est destinée à être installée sur un poste qui possède Outlook (97, 2000 ou XP), vous pouvez employer l'Automation d'Outlook pour envoyer des e-mails. Dans votre projet VB, vous devrez d'abord ajouter une référence à Outlook. Pour ce faire, cliquez sur le menu "Projets/Références...". Dans la liste des références disponibles,sélectionnez "Microsoft Outlook X.X Object Library" et cliquez sur "OK". Vous pouvez à présent taper le code permettant d'envoyer un e-mail via Outlook :

Private Sub Command1_Click()

    Dim OutlookApp As New Outlook.Application
    Dim NewMail    As Outlook.MailItem

    Set NewMail = OutlookApp.CreateItem(olMailItem)
    NewMail.Recipients.Add ("adresse@serveur.com")
    NewMail.Subject = "Bon anniversaire"
    NewMail.Body = "Je te souhaite un bon anniversaire !"
    NewMail.Send

End Sub

Utilisation des sockets et implémentation des protocoles POP3, SMTP, etc.

La solution idéale, mais plus difficile à mettre en oeuvre, est d'utiliser Winsock (le contrôle ou l'API) et d'implémenter soi-même les protocoles POP3, IMAP et SMTP. On pourra ainsi envoyer des messages depuis un poste ne possèdant ni Office, ni Outlook Express, ni aucun autre logiciel de messagerie. Ces protocoles sont parfaitement décrits par des RFC, dont on trouvera la liste avec les liens hypertextes correspondants dans la section "Pour Aller plus loin" en fin d'article.

Le programme suivant est un exemple d'implémentation du protocole SMTP permettant d'envoyer des e-mails en employant le contrôle Winsock :

Option Explicit

Private Enum SMTPSessionState
    SMTP_CONNECT
    SMTP_HELO
    SMTP_MAIL
    SMTP_RCPT
    SMTP_DATA
    SMTP_SENDMESSAGE
    SMTP_QUIT
End Enum

Private CurrentSMTPSessionState As SMTPSessionState

' Copies locales
Private lcSenderDisplayName     As String
Private lcSenderAddress         As String
Private lcRecipientDisplayName  As String
Private lcRecipientAddress      As String
Private lcSubject               As String
Private lcMessage               As String

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
                CurrentSMTPSessionState = SMTP_HELO ' Change l'état de la session
                
                ' Récupère le nom de domaine
                sDataToSend = Right(lcSenderAddress, Len(lcSenderAddress) - InStr(lcSenderAddress, "@"))
                
                ' Et envoie la commande HELO au serveur
                sDataToSend = "HELO " & sDataToSend & vbCrLf
                Winsock1.SendData sDataToSend

            Case SMTP_HELO
                CurrentSMTPSessionState = SMTP_MAIL ' Change l'état de la session

                ' Et envoie la commande MAIL au serveur
                sDataToSend = "MAIL FROM:<" & lcSenderAddress & ">" & vbCrLf
                Winsock1.SendData sDataToSend

            Case SMTP_MAIL
                CurrentSMTPSessionState = SMTP_RCPT ' Change l'état de la session

                ' Et envoie la commande RCPT au serveur
                sDataToSend = "RCPT TO:<" & lcRecipientAddress & ">" & vbCrLf
                Winsock1.SendData sDataToSend

            Case SMTP_RCPT
                CurrentSMTPSessionState = SMTP_DATA ' Change l'état de la session

                ' Et envoie la commande DATA au serveur
                sDataToSend = "DATA" & vbCrLf
                Winsock1.SendData sDataToSend

            Case SMTP_DATA
                CurrentSMTPSessionState = SMTP_SENDMESSAGE  ' Change l'état de la session

                ' 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
                CurrentSMTPSessionState = SMTP_QUIT ' Change l'état de la session
                
                ' Affichage d'un message de confirmation, à supprimer dans le code définitif
                MsgBox "Le message envoyé avec succès.", vbInformation

                ' Et envoie la commande QUIT au serveur
                Winsock1.SendData "QUIT" & vbCrLf

            Case SMTP_QUIT
                Winsock1.Close  ' Ferme la connexion
        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(ByVal SMTPServeur As String, _
                   ByVal SenderAddress As String, _
                   ByVal RecipientAddress As String, _
                   ByVal Subject As String, _
                   ByVal Message As String, _
                   Optional ByVal SenderDisplayName As String, _
                   Optional ByVal 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

'
' Exemple D'utilisation
'
Private Sub Command1_Click()

    Call SendMail("smtp.serveur.com", "jean.dubois@serveur.com", "john.smith@serveur.com", _
                 "Petit test", "Hello !", "Jean Dubois", "John Smith")

End Sub

On notera que l'implémentation repose essentiellement sur l'utilisation d'un automate à états finis, dont on trouvera une description de principe dans l'article : Comment valider des données complexes ?.

Pour aller plus loin

• RFC POP3 (Post Office Protocol), en anglais et en français
• RFC SMTP (Simple Mail Transfer Protocol), en anglais et en français
• RFC IMAP4 (Internet Message Access Protocol ), en anglais et en français
• RFC 2822 (Format des messages), en anglais et en français
• MSDN : documentation de la fonction de l'API ShellExecute

Voir aussi :

• Comment envoyer des e-mails via Lotus Notes ?
• Comment sauvegarder les pièces jointes d'un message avec Outlook depuis une application Visual Basic ?
• Comment valider des données complexes?
• Comment exécuter un autre programme depuis une application VB ?