Insertion signature Outlook en fin de mail

Le 13/01/2021 à 21:28

Bonsoir le forum,

Je déterre un sujet apparemment fréquent (désolé), j'ai étudié plein de sujets équivalents mais n'arrive pas à comprendre pourquoi cela ne fonctionne pas chez moi :

Je cherche tout simplement à afficher ma signature Outlook à la fin d'un mail de relance : voici mon code et l'emplacement du fichier de ma signature :

Sub affichage_mail()

    Dim rng As Range, choix_destcc As Range, destcc As Range
    Dim msg_cc As String
    Dim somme As Single
    Dim Signature As String
    Dim SigString As String

    Set OlApp = CreateObject("Outlook.Application")  'création instance application outlook
    Set emails = OlApp.Session.GetDefaultFolder(OlFolderSentMail).Items   'assignation évènements éléments envoyés

    Set rng = Me.Range("A3:G4")
    Set rng = Union(rng, Me.Range("A5").CurrentRegion)

    With OlApp.CreateItem(olMailItem)
        .To = Me.Range("I5")

        .Subject = "RELANCE" & "-" & Me.Range("C5") & " - " & Me.Range("B5")

        MsgBox ("Choisissez avec la souris et la touche Ctrl les destinataires CC du mail")
        Set choix_destcc = Application.InputBox _
            ("Sélectionner Colonne I les destinataires CC avec la souris", , , , , , , 8)

        msg_cc = ""

        For Each destcc In choix_destcc.Areas
            If destcc.Count = 1 Then
                msg_cc = msg_cc & destcc.Value & ";"
            ElseIf destcc.Columns.Count = 1 Then
                msg_cc = msg_cc & Join(Application.Transpose(destcc.Value), ";") & ";"
            End If
        Next destcc
        .CC = msg_cc

        somme = 0
        On Error Resume Next
        somme = Me.Cells.Find("TOTAL*").Offset(, 1).Value

        On Error GoTo 0
        .HTMLBody = "Bonjour," & "<br>" & "<br>" & "<br>" & "Au pointage de votre compte, ci-dessous :" & "<br>" & _
        RangetoHTML(rng) & "<br>" & "<br>" & "Nous vous remercions ," & _
        " et restons . " & "<br>" & "<br>" & "Dans cette attente," & "<br>" & Signature

        'SigString = Environ("appdata") & _
                "\Microsoft\Signatures\herve.htm"

        SigString = "C:\Users\HRO.VQL\AppData\Roaming\Microsoft\Signatures\herve.htm"

   MsgBox SigString

        Signature = GetBoiler(SigString)

    On Error Resume Next

    'Set OlApp = Nothing
    'Set emails = Nothing

     .Display 'afficher le mail et attendre que l'utilisateur l'envoie ou non

    End With

End Sub
Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
image

Quelqu'un a-t-il une idée ? (j'en suis sûr)

Merci d'avance

Michael

Le 14/01/2021 à 04:41

Bonjour,

Pas d'inquiétude, cela 'a jamais non plus fonctionné chez moi.

Mais il y a beaucoup plus simple ... tu remets à la fin, à la place de signature :

.HTMLBody
.HTMLBody = "Bonjour," & "<br>" & "<br>" & "<br>" & "Au pointage de votre compte, ci-dessous :" & "<br>" & _
        RangetoHTML(rng) & "<br>" & "<br>" & "Nous vous remercions ," & _
        " et restons . " & "<br>" & "<br>" & "Dans cette attente," & "<br>" & .HTMLBody

et tu simplifies ton code en supprimant tout ce qui est GetBoiler, SigString et compagnie ...

Le 14/01/2021 à 05:17

Bonjour le fil,

L'ami Steelson à oublier une chose, il faut afficher le mail au début pour pouvoir avoir la signature

Voici le code corrigé et la fonction RangeToHTML()

Option Explicit
' Déclaration en tout début de module
Dim OlApp As Object, eMails As Object
' Création d'une instance Outlook en Late Binding
' Il faut déclarer les constantes nécessaires
Const OlFolderSentMail As Long = 5
Const olMailItem = 0

Sub Affichage_Mail()
  Dim Sht As Worksheet, Rng As Range, Choix_Destcc As Range, Destcc As Range
  Dim Msg_Cc As String
  Dim Somme As Single

  Set OlApp = CreateObject("Outlook.Application")  'création instance application outlook
  Set eMails = OlApp.Session.GetDefaultFolder(OlFolderSentMail).Items   'assignation évènements éléments envoyés

  Set Sht = ActiveSheet
  Set Rng = Sht.Range("A3:G4")
  ' ATTENTION !
  ' Multi-selection ne fonctionnera pas avec Copy
  'Set rng = Union(rng, Sht.Range("A5").CurrentRegion)

  With OlApp.CreateItem(olMailItem)
    .Display  ' Afficher le mail pour la signature
    '
    .To = Sht.Range("I5")
    .Subject = "RELANCE" & "-" & Sht.Range("C5") & " - " & Sht.Range("B5")

    MsgBox ("Choisissez avec la souris et la touche Ctrl les destinataires CC du mail")
    Set Choix_Destcc = Application.InputBox _
      ("Sélectionner Colonne I les destinataires CC avec la souris", , , , , , , 8)

    Msg_Cc = ""

    For Each Destcc In Choix_Destcc.Areas
      If Destcc.Count = 1 Then
        Msg_Cc = Msg_Cc & Destcc.Value & ";"
      ElseIf Destcc.Columns.Count = 1 Then
        Msg_Cc = Msg_Cc & Join(Application.Transpose(Destcc.Value), ";") & ";"
      End If
    Next Destcc
    .CC = Msg_Cc

    Somme = 0
    On Error Resume Next
    Somme = Sht.Cells.Find("TOTAL*").Offset(, 1).Value
    On Error GoTo 0

    .HTMLBody = "Bonjour," & "<br>" & "<br>" & "<br>" & "Au pointage de votre compte, ci-dessous :" & "<br>" & _
      RangetoHTML(Rng) & "<br>" & "<br>" & "Nous vous remercions ," & _
      " et restons . " & "<br>" & "<br>" & "Dans cette attente," & "<br>" & .HTMLBody
  End With
  '
  ' Vider les variables objet
  Set Sht = Nothing
  Set OlApp = Nothing
  Set eMails = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

@+

Le 14/01/2021 à 05:34

Bonjour Bruno,

BrunoM45 a écrit :

L'ami Steelson à oublier une chose, il faut afficher le mail au début pour pouvoir avoir la signature

je remarque tu as adoptes aussi cette solution, mais est-ce que tu es sûr qu'il faille commencer par un display ? je ne travaille plus avec outlook, mais j'ai regardé mes archives comme ici :

Sub envoi(destinataire As String, titre As String, texte As String)
Dim messagerie As Object
Dim email As Object

    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    With email
        .To = destinataire
        .Subject = titre
        '.body = texte ' envoi texte brut
        .htmlbody = texte & .htmlbody ' envoi html avec signature
        .display ' .send pour envoi direct
    End With
    Set email = Nothing
    Set messagerie = Nothing

End Sub
Le 14/01/2021 à 14:38

Bonjour Steelson,

Merci pour cette réponse (très) matinale.

Mais cela ne fonctionne pas chez moi (et d'ailleurs je n'en comprends pas le principe)

Michael

Le 14/01/2021 à 15:18

Re-

MICHAELH a écrit :

Mais cela ne fonctionne pas chez moi

Curieux !

MICHAELH a écrit :

et d'ailleurs je n'en comprends pas le principe

quand tu crées le mail en virtuel par Set email = messagerie.CreateItem(0) il a déjà un attribut .HTMLbody qui contient ta signature par défaut. J'ajoute juste un texte avant celui pré-existant par défaut, c'est-à-dire la signature.

Le 14/01/2021 à 15:36

Bonjour le fil,

@Steelson, oui je suis certain du fonctionnement c'est ce que j'utilise depuis au moins 3 ans maintenant
Pour explication, le display fait comme sur Outlook avec le menu "Nouveau courrier", corps vierge mais avec la signature

@MICHAELH, avez-vous essayé ma procédure ?
Sinon, c'est dommage il faut juste ajouter ".Display" au début

@+

Le 14/01/2021 à 16:34

je suis en formation, je teste dès que je peux, merci !

Le 15/01/2021 à 12:35

Bonjour Bruno,

Ca y est j'ai testé votre code et ça marche super !

Avec des petites réserves :

-j'ai désactivé 'Dim OlApp As Object, et
'Dim eMails As Object

car ça me générait une erreur (?)

-j'ai désactivé 'Set eMails = Nothing car ensuite dans la macro j'ai une private sub (de Thev) qui confirme que le mail est parti et qui propose à l'utilisateur de gérer un autre mail s'il le souhaite.

Le plus gênant finalement c'est un message de sécurité d'Outlook qui demande d'autoriser l'accès, et qu'on ne peut autoriser que pendant 10 minutes.

Voyez-vous un moyen d'éviter ce contrôle ?

En tout cas merci, et je pense que votre code servira à d'autres !

Michael

Le 16/01/2021 à 04:04

Bonjour MICHAELH

MICHAELH a écrit :

Avec des petites réserves :

-j'ai désactivé 'Dim OlApp As Object, et
'Dim eMails As Object

car ça me générait une erreur (?)

Ce n'est pas normal à moins qu'elles soient déclarées déjà ailleurs

MICHAELH a écrit :

Le plus gênant finalement c'est un message de sécurité d'Outlook qui demande d'autoriser l'accès, et qu'on ne peut autoriser que pendant 10 minutes.

Voyez-vous un moyen d'éviter ce contrôle ?

Je ne vois pas, je n'ai pas ce problème chez moi, peut-on avoir une copie d'écran du message ?

MICHAELH a écrit :

En tout cas merci, et je pense que votre code servira à d'autres !

Michael

De rien, je l'espère aussi

@+

Le 16/01/2021 à 04:41

Bonjour BrunoM45, MichaelH,

Le message de sécurité peut venir vient surement de l'antivirus

Il faut vérifier cela chez vous dans les options Outlook :

image
Le 16/01/2021 à 12:37

Bonjour BrunoM45 et Shenzar,

J'avais ce message :

image

En suivant le conseil de Shenzar, cela ne se reproduit pas, en effet.

Merci !

Michael

Le 30/01/2021 à 08:45

Bonjour

Je reviens moi aussi sur ce sujet qui m'a bien aidé. Je l'ai adapté à mes besoins sans problème. Le petit hic, eh oui il y en a un, je n'arrive pas à utiliser .Item.SentOnBehalfOfName dans ce code. Est-ce possible car moi ça bloque ?

Cordialement.

Public Sub envoimail2(ByVal destinataireaction As String, ByVal destinataireinfo As String, ByRef tableau As Range, ByVal expediteur As String, ByVal objet As String)
  Dim rng As Range

  Set OlApp = CreateObject("Outlook.Application")  'création instance application outlook
  Set eMails = OlApp.Session.GetDefaultFolder(OlFolderSentMail).Items   'assignation évènements éléments envoyés

  Set rng = tableau

  With OlApp.CreateItem(olMailItem)
    .Display  ' Afficher le mail pour la signature (à mettre absolument sinon pas de signature)
    '
    .Subject = objet
    .Item.SentOnBehalfOfName = expediteur
    .To = destinataireaction

    .Cc = destinataireinfo

    .HTMLBody = RangetoHTML(rng) & .HTMLBody

  .Send
  End With

  '
  ' Vider les variables objet

  Set OlApp = Nothing
  Set eMails = Nothing
End Sub
Le 30/01/2021 à 09:43

Bonjour Darkvad

Je pense que c'est une fonction juste en lecture, ce qui serait logique pour éviter les usurpations d'identité

Pas bien !

Le 30/01/2021 à 09:51
ActiveSheet.Range("b3:q35").Select ' la plage de cellules à envoyer qui correspond à la demande
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
    .Item.SentOnBehalfOfName = "xxxx@test.fr"
    .Item.To = destinataireaction
    .Item.Cc = destinataireinfo
    .Item.Subject = "Recherche"
    .Item.Send
     Sheets("prospection").Select
     Range("a1").Select
End With

Bonjour,

Je l'utilise actuellement avec un autre code. J'utilise une boite mail fonctionnelle, ce qui me permet d'envoyer le mail avec en référence l'adresse de ma fonctionnelle.

Le 30/01/2021 à 10:03

Darkvad, merci de bien vouloir ouvrir un fil en citant ce sujet éventuellement

Le 30/01/2021 à 10:45

Bonjour,

enlève item, ce n'est pas logique car le reste est directement raccroché à :

With OlApp.CreateItem(olMailItem)
darkvad a écrit :

Bonjour

Je reviens moi aussi sur ce sujet qui m'a bien aidé. Je l'ai adapté à mes besoins sans problème. Le petit hic, eh oui il y en a un, je n'arrive pas à utiliser .Item.SentOnBehalfOfName dans ce code. Est-ce possible car moi ça bloque ?

Cordialement.

  With OlApp.CreateItem(olMailItem)
    .Display  ' Afficher le mail pour la signature (à mettre absolument sinon pas de signature)
    '
    .Subject = objet
    .Item.SentOnBehalfOfName = expediteur
    .To = destinataireaction

    .Cc = destinataireinfo

    .HTMLBody = RangetoHTML(rng) & .HTMLBody

  .Send
  End With
Le 30/01/2021 à 12:15

Merci,

C'était effectivement le problème. Cela fonctionne maintenant.

Rechercher des sujets similaires à "insertion signature outlook fin mail"