Envoyer des mails en utilisant un GMAIL

Pour envoyer des mails directement par ACCESS, on peut utiliser un émail de votre compte GMAIL de Google.

Le code ci-dessous permet également de joindre un fichier.

La seule contrainte, pour que l'envoi se fasse de manière transparente, est d'utiliser un compte sans double identification; nommé "validation à deux étapes".

Utilisation :

La fonction renvoi "True" si le mail à bien été envoyé, "False" en cas d'échec...

Le fichier joint et le nom du destinataire sont optionnel.

Avant l'utilisation de la fonction, il faudra renseigner les données de l'expéditeur. Ces données peuvent, bien sûr, également être extrait d'une table.

If SendGmail("to", "Titre du mail", "contenu", "doc1.pdf", "Nom destinataire") = False Then
    MsgBox "Problème !"
    'votre code...
End If

La fonction :

Option Compare Database
Option Explicit


Public Function SendGmail(sEmailTo As String, _
                          sSubject As String, _
                          sMessage As String, _
                          Optional sJoinFile As String = "", _
                          Optional sReceiverName As String = "") As Boolean

    On Error GoTo Err_ErrorHandler
    SendGmail = True    ' renvoyé si pas d'erreur

    'Standard CDO Constants
    Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
    Const conCdoSendUsingPort As Integer = 2
    Const conCdoBasic As Integer = 1
    Const conStrSmtpServer As String = "smtp.gmail.com"
    Const conCdoSmtpUseSSL As Boolean = True  'Utilisation de "Secure Sockets Layer"
    Const conCdoSmtpServerPort As Integer = 465  'Port sortant (serveur SMTP)

    Dim oMsg As Object
    Dim oConf As Object
    Dim sSenderName As String
    Dim sSenderEmail As String
    Dim sSenderPSW As String
    Dim sErrMsg As String
    '/
    '/ renseignez ci-dessous les données de l'expéditeur :
    '/ nom de l'expéditeur, adresse gmail, mot de passe
    '/
    sSenderName = "Durant André"
    sSenderEmail = "A_Durant@gmail.com"
    sSenderPSW = "mot_de_passe"

    'Create Objects
    Set oMsg = CreateObject("CDO.Message")
    Set oConf = CreateObject("CDO.Configuration")
    Set oMsg.Configuration = oConf

    '// Composition du message - ne pas modifier !
    If sReceiverName = "" Then sReceiverName = sEmailTo

    With oMsg
        .To = sReceiverName & " <" & sEmailTo & ">"
        .From = sSenderName & " <" & sSenderEmail & ">"
        .Subject = sSubject
        .TextBody = sMessage
        If Len(sJoinFile) > 0 Then
            .AddAttachment sJoinFile
        End If
    End With

    'options à ne pas modifier
    With oConf.Fields
        .Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
        .Item(conStrPrefix & "smtpserver") = conStrSmtpServer
        .Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
        .Item(conStrPrefix & "sendusername") = sSenderEmail
        .Item(conStrPrefix & "sendpassword") = sSenderPSW
        .Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
        .Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
        .Update
    End With

    'Envoi du mail
    oMsg.Send

Exit_ErrorHandler:
    Set oMsg.Configuration = Nothing
    Set oConf = Nothing
    Set oMsg = Nothing
    Exit Function

Err_ErrorHandler:
    If err.Number <> 0 Then
        SendGmail = False
        Select Case err.Number
            Case -2147220977
                sErrMsg = "Format émail incorrect"
            Case -2147220980
                sErrMsg = "Renseignez un émail"
            Case -2147220960
                sErrMsg = "Erreur de port"
            Case -2147220973
                sErrMsg = "Pas de connection internet"
            Case -2147220975
                sErrMsg = "Erreur de mot de passe"
            Case Else
                sErrMsg = "Erreur imprévue..."
        End Select
        MsgBox sErrMsg & vbCrLf & err.Number & " - " & err.Description
    End If

    Resume Exit_ErrorHandler
End Function