Envoi Email

' DATE:     23/10/2010, 11h42
' AUTEUR:   Simplifi
' SOURCE:   http://www.developpez.net/forums/d990658/logiciels/microsoft-office/access/vba-access/envoyer-mails-cdo/
Function fctEnvoiMail(strExpediteur As String, strDestinataires As String, _
                             strSujet As String, strMessage As String, strPiecesJointes As String, _
                             strSmtpAuthenticate As String, strSendUsername As String, strSendPassword As String, strSendUsing As String, _
                             strSmtpServer As String, strSmtpServerPort As String)
'
' ENVOYER UN MAIL
'
' strExpediteur [STRING] = Adresse mail de l'expéditeur
' strDestinateurs [STRING] = Adresses mails des destinataires (espacées par une virgule, à vérifier!)
' strSujet [STRING] = Sujet du mail
' strMessage [STRING] = Message du mail
' strPiecesJointes [STRING] = Chemins des pièces jointes (espacées par une virgule, à vérifier!)
' strSmtpAuthenticate [STRING] = 0 pas d'authentification, 1 authentification demandée
' strSendUsername [STRING] = Login du serveur
' strSendPassword [STRING] = Mot de passe
' strSendUsing [STRING] = Type de serveur. Ex.: 2 = smtp
' strSmtpServer [STRING] = Adresse du serveur. Ex.: free.smtp.fr
' strSmtpServerPort [STRING] = N° du port. Ex.: 25
'
' RETOUR : pas de retour
'

    ' Gestion des erreurs
    On Error GoTo ErrorHandler
    
    Const cdoBasic = 1
    With CreateObject("CDO.Message")
        If err Then
            MsgBox "Problème de CDO non installé sur le serveur WEB": Exit Function
        Else
            .From = strExpediteur       'Expéditeur
            .To = strDestinataires      'Destinataire
            .BCC = strExpediteur        'Copie
            .Subject = strSujet         'Sujet
            .TextBody = strMessage      'Message
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = strSmtpAuthenticate
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSendUsername
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSendPassword
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = strSendUsing
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
            .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSmtpServerPort
            .Configuration.Fields.Update
            .AddAttachment strPiecesJointes
            .Send
            If err Then
                If i = 1 Then MsgBox err.Number & "***" & "Le message n'a pas pu être expédié."
            Else
                MsgBox "Message envoyé." & _
                        Chr(10) & _
                        "Une copie devrait vous parvenir dans quelques instants.", _
                        vbInformation, _
                        "Message envoyé"
            End If
        End If
        On Error GoTo 0
    End With

' Gestion des erreurs
ErrorHandler:
    
    If err.Number <> 0 Then
        ' Message
        MsgBox "Oupss !" & _
                Chr(10) & _
                "Erreur N°: " & err.Number & _
                Chr(10) & _
                "Description: " & err.Description, vbCritical, err.Number
    End If

End Function

'> Envoyer mail
    Call fctEnvoiMail(strExpediteur, strDestinataire, strSujet, strMessage, strPJAEnvoyer, _
                      strSmtpAuthenticate, strSendUsername, strSendPassword, strSendUsing, strSmtpServer, strSmtpServerPort)