VBA envoi mail Outlook avec signature

Bonsoir à tous,

Je viens d'arriver à un nouveau poste et je récupère une macro qui permet d'envoyer automatiquement des mails depuis gmail avec une pièce jointe.

J'ai réussi à la modifier pour envoyer les mails via Outlook et pouvoir mettre en place du publipostage.

Je suis novice en VBA alors je suis très content de ce résultat. Mais il me manque un petit quelque chose pour que ce soit parfait. Je n'arrive pas à intégrer ma signature aux mails créés.

En fouillant sur internet, j'ai trouvé un explication utilisant GetBoiler. Mais quand je l'utilise un message d'erreur m'indique que la fonction n'est pas définie...

J'ai donc besoin de votre aide pour réussir à intégrer ma signature

Au passage, si vous avez des explications sur la partie "Nettoyage" en bas de page, je suis preneur

En vous remerciant pour votre lecture !

A très vite !

Sub Envoi_Mail()

Dim Fichier As String
Dim Table(), j As Integer
Dim fields As Variant
Dim ws As Worksheet
Set oOutlook = CreateObject("Outlook.Application")

Set ws = ThisWorkbook.Sheets("Localisee_IFT")   'Onglet ou feuille source de données ici Feuil1
Table = ws.Range("A2:AH2")   'Plage de données que l'on veut

For j = LBound(Table, 1) To UBound(Table, 1) 'on boucle chaque cellule de la première colonne de notre table
        Application.StatusBar = "Nom processing file # " & j & "/" & UBound(Table, 1)

Fichier = Table(j, 1) & ".docx"

  Set oMailItem = oOutlook.CreateItem(0)

'Set All Email Properties

    With oMailItem
        .Subject = Table(j, 1) & " Annule et remplace le précédent"
        .To = Table(j, 34)
        .HTMLBody = "Bonjour, <br>" _
          & "vous trouverez ci-joint la nouvelle notice " _
          & Table(j, 1) _
          & " pour la campagne 2021. La mesure est financée par " _
          & Table(j, 2) _
          & " <br>" _
          & Table(j, 34) _
          & "<br>" _
          & "Cordialement" _
          & GetBoiler("C:\Users\nameUSER\AppData\Roaming\Microsoft\Signatures\XXX.htm")
        .Attachments.Add ThisWorkbook.Path & "\" & Fichier

       .Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
       '.Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
       '.Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
    End With

Next j

   'nettoyage...
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

Exit Function
EnvoyerEmailErreur:
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

    MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Function

Bonsoir,

Vous pouvez utiliser cette fonction :

Function Signature(nom_signature As String) As String
    Dim FSO As Object, TextStream As Object
    Dim nom_fichier As String

    Signature = Empty
    On Error Resume Next
    Set FSO = CreateObject("Scripting.FileSystemObject")
    nom_fichier = Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & ".htm"
    Set TextStream = FSO.OpenTextFile(nom_fichier)
    If Err.Num = 0 Then
        Signature = TextStream.ReadAll
        'remplacement adresse relative images par adresse absolue
        Signature = Replace(Signature, nom_signature & "_files/", Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & "_files/")
    End If
End Function

Soit

          & "Cordialement" _
          & Signature(nom_signature)
        .Attachments.Add ThisWorkbook.Path & "\" & Fichier

Où nom_signature est le nom "XXX" de votre signature.

Bonjour le fil

@Thev, sauf erreur de ma part, le problème de cette vieille fonction c'est qu'elle ne sait pas intégrer le logo (s'il y en a un) de la signature

Il suffit simplement d'afficher le mail avant de le complèter et d'insérer de nouveau le corps du message

With oMailItem
    .Display
    .Subject = "Mon sujet"
    .To = "eMail_Destrinataire@fai.fr"
    .HTMLBody = "Bonjour, <br> bla bla bla <br>" & .HTMLBody
End With

@+

Merci pour vos réponses !

En effet, la solution de @BrunoM45 fonctionne parfaitement et me convient !

Peut être qu'à terme le fait d'ouvrir la boîte Outlook pour des envois en masse posera problème. Mais même pas sûr, je verrais à l'usage.

Merci encore !

Bonjour,

Un complément d'information sur l'éventuel emploi de la fonction signature, dans le cas où l'on souhaite une signature indépendante du compte d'envoi du mail.

Cette fonction sait parfaitement intégrer le logo ou plusieurs, sous réserve qu'elle soit francisée ...

'remplacement adresse relative images par adresse absolue
        Signature = Replace(Signature, nom_signature & "_fichiers/", Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & "_fichiers/")

Bonjour le fil

@Thev, voici la représentation de ce que je voulais dire

2021 03 30 12h31 07

Cette fonction n'arrive pas à importer les images dans la signature

C'est pour cette raison que j'utilise systématiquement

    With oMailItem
      .Display
      .Subject = "Sujet du mail"
      .To = "AdresseMailduDestiantaire"
      .HTMLBody = "Bonjour, <br>" _
                & "vous trouverez ci-joint la nouvelle notice " _
                & " pour la campagne 2021. La mesure est financée par " _
                & "<br>" _
                & "Cordialement" & .HTMLBody
'      .Send
    End With

@+

Bonjour BrunoM45,

Il faut utiliser la fonction ainsi modifiée (files --> fichiers) pour bien récupérer l'adresse des images et cela fonctionne :

Function Signature(nom_signature As String) As String
    Dim FSO As Object, TextStream As Object
    Dim nom_fichier As String

    Signature = Empty
    On Error Resume Next
    Set FSO = CreateObject("Scripting.FileSystemObject")
    nom_fichier = Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & ".htm"
    Set TextStream = FSO.OpenTextFile(nom_fichier)
    If Err.Num = 0 Then
        Signature = TextStream.ReadAll
        'remplacement adresse relative images par adresse absolue
        Signature = Replace(Signature, nom_signature & "_fichiers/", Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & "_fichiers/")
    End If
End Function

Par ailleurs, je pense que par rapport à l’apposition de la signature automatique via un .Display, cette fonction présente surtout un intérêt si l'on souhaite une signature non reliée au compte émetteur du mail.

Re,

Désolé, mais c'est toujours pareil à mon taf

Bonjour,

Tu dois avoir une configuration spécifique à ton taf.

Chez toi, ça devrait fonctionner.

Merci pour ces retours complémentaires !

J'aimerais bien tester mais je n'ai pas encore compris comment utiliser une fonction dans une macro Lorsque j'ajoute la fonction au début ou à la fin de la macro ça me demande de déclarer "Signature" : "argument non déclarer". Ce qui m'emmène à la question : comment déclarer une fonction ?

Bonjour,

Il suffit d'ajouter le code de la fonction après la procédure Sub.

@thev Merci pour ta réponse, j'y vois un peu plus clair sur la structure. Toutefois, ils me demandent toujours de déclarer "Signature" en indiquant : "argument non facultatif".

J'imagine qu'en début de procédure Sub je dois faire quelque chose du genre "Dim Signature As ...". J'ai essayé String et Object mais ça n'a pas fonctionné

Bonjour,

Signature est une fonction ayant pour argument le nom de la signature. Si la signature s'appelle par exemple : nom1, il faut mettre Signature("nom1").

Je comprends un peu mieux comment marchent les fonctions, merci.

J'ai bien ajouté la fonction en bas dessous de End Sub. Mon problème vient de la partie du corps du mail. Juste après le "Cordialement," j'indique ça :

    With oMailItem
        '.Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
        .Subject = Table(j, 1) & " Annule et remplace le précédent"
        .To = Table(j, 34)
        .HTMLBody = "<font size=3><font face=Verdana>Bonjour, <br>" _
          & "vous trouverez ci-joint la nouvelle notice " _
          & Table(j, 1) _
          & " pour la campagne 2021. La mesure est financée par " _
          & Table(j, 2) _
          & " <br>" _
          & Table(j, 34) _
          & "<br>" _
          & "Cordialement </font>"
        Signature Replace(Signature, NA & "_fichiers/", Environ("APPDATA") & "\Microsoft\Signatures\" & NA & "_fichiers/")
        .Attachments.Add ThisWorkbook.Path & "\" & Fichier
        .Display

C'est pour le "Signature" entre parenthèse que l'on m'indique que l'argument est facultatif (et non pas pour la fonctionne comme je le pensais au départ).

Je ne sais pas si je suis très clair...

Bonsoir,

Si le nom de votre signature est : NA, vous devez mettre

& "Cordialement </font>"
&  Signature ("NA")
.Attachments.Add ThisWorkbook.Path & "\" & Fichier
.Display

Ah génial ça fonctionne !
Merci infiniment pour votre patience

Sujet doublement résolu ! Avec une signature par défaut et une signature souhaitée (qui permet d'éviter l'affichage de chaque mail)

Rechercher des sujets similaires à "vba envoi mail outlook signature"