Fonction envoi de mail par vba sans client local, par serveur smtp

Commenter

Contenu du snippet

Cette fonction est simple, courte, facile à utiliser, elle ne nécessite pas de Outlook ou autre Lotus installé en local, somme toute ça semble idéal. Il faut juste une DLL, donc cocher la référence associée:
"Microsoft CDO for windows 2000 library"
(correspondant au fichier system32/cdosys.dll)

Cette fonction envoie le mail avec la ou les pièce(s) jointe(s) (je n'utilise pas de body - texte dans le mail mais ça peut s'ajouter dans la fonction)
Pratique pour l'envoi en masse de messages sur une base Access.

J'utilise les constantes suivantes pour la configuration:

' configuration SMTP pour envoi de mail
Public Const MAIL_SENDUSING = 2
Public Const MAIL_AUTHENTICATE = 1
Public Const MAIL_CPT_SENDUSR = "<nom du compte>"
Public Const MAIL_CPT_SENDPASS = "<passe du compte>"
Public Const MAIL_FROM = "<mail de l'expéditeur>"
Public Const MAIL_SMTP_SERVER = "<nom serveur>"
Public Const MAIL_SMTP_SERVERPORT = 25

Source / Exemple : 


'''""""""""""""""""""""""""""""""""""""""""""""""""""'''
'
'   FONCTION : envoyer un mail par SMTP
' pstrTo : 1 ou plusieurs destinataire(s)
' pstrSubject : objet du mail
' pvarAttachFile : 1 ou plusieurs fichiers joints - string ou array de string
'
'''""""""""""""""""""""""""""""""""""""""""""""""""""'''
Public Function SMTPSendMail(pstrTo As String, pstrSubject As String, Optional pvarAttachFile As Variant) As Boolean
On Error GoTo SMTPSendMail_Err

    Dim i As Long
    Dim objEmail As New CDO.Message
    'Set objEmail = CreateObject("CDO.Message")
    
    objEmail.From = MAIL_FROM
    objEmail.To = pstrTo
    objEmail.Subject = pstrSubject
    
    ' Aucun corps de message, uniquement la pièce jointe
    ' laisser un TextBody avec chaine vide, sinon le mail peut planter (pièce jointe incomplète)
    objEmail.TextBody = ""
    
    ' Ajout de la pièce jointe, 1 ou plusieurs fichiers
    If Not IsMissing(pvarAttachFile) Then
        If IsArray(pvarAttachFile) Then
            ' parcourrir le tableau
            For i = LBound(pvarAttachFile) To UBound(pvarAttachFile)
                objEmail.AddAttachment pvarAttachFile(i)
            Next i
        Else
            objEmail.AddAttachment pvarAttachFile ' "C:\temp\Bon de commande.pdf"
        End If
    End If
    
    With objEmail.Configuration.Fields
        .Item(CdoConfiguration.cdoSendUsingMethod) = MAIL_SENDUSING
        .Item(CdoConfiguration.cdoSMTPAuthenticate) = MAIL_AUTHENTICATE
        .Item(CdoConfiguration.cdoSendUserName) = MAIL_CPT_SENDUSR
        .Item(CdoConfiguration.cdoSendPassword) = MAIL_CPT_SENDPASS
        .Item(CdoConfiguration.cdoSMTPServer) = MAIL_SMTP_SERVER
        .Item(CdoConfiguration.cdoSMTPServerPort) = MAIL_SMTP_SERVERPORT
        .Update
    End With
    objEmail.Send

    SMTPSendMail = True
Exit Function
SMTPSendMail_Err:
    MsgBox Err.Description

End Function

Conclusion :


LA fonction renvoie TRUE en cas de succès, false sinon.

J'ai remarqué que si j'enlève la ligne suivante, les pièces jointes peuvent être illisibles (zip) ou incomplètes (pdf à moitié vierges!):
objEmail.TextBody = ""
Donc même si j'ai aucun texte dans le mail je le laisse.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (pifou25)