signature mail avec image/lien

**Kintin** · 07/02/2023, 13h41

Bonjour,

Beaucoup de sujet semble traiter d'une problématique similaire mais je n'ai pas réussi à dénicher le bon topic.

Ma société impose une signature type remplie d'image cliquable renvoyant à des liens hypertexte.

Avant cela, lors de l'automatisation de mes mails j'employais ce code ci joint :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.HTMLBody = "<html><body>" & var1x & getsignature(Signaturex) & "</body></html>"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function getsignature(signaturepath As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.getfile(signaturepath).openastextstream(1, -2)
getsignature = ts.readall
ts.Close
End Function

Mais les images ne s'incorporent pas au mail.
Donc... Est-il actuellement possible d'insérer une signature enregistrée contenant des images cliquables via une commande vba lancée à partir d'excel?

ps: je ne suis pas parvenu à réaliser un pdf cliquable comme vu dans un ancien post et l'unique solution que j'imagine serait de mettre en page la signature via le codage, mais cela me parait fort complexe vu le format précis que cette signature doit avoir.

Merci d'avance pour vos conseils

**mromain** · 08/02/2023, 12h40

Bonjout Kintin, le forum,

J'imagine que ta fonction getsignature te renvoie le contenu du fichier laSignature.htm située dans le dossier %appdata%\Microsoft\Signatures contenant les signatures d'Outlook.

Si c'est bien ça, cela vient surement du fait qu'au sein des fichiers .htm des signatures, les images sont référencées avec des emplacements relatifs au dossier des signatures (%appdata%\Microsoft\Signatures).

La fonction ci-dessous UserSignatures peut résoudre ce problème.
Elle charge l'ensemble des signature en modifiant les emplacements relatifs en emplacement absolus.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Public Function UserSignatures() As Collection
Dim oFso As Object          'Scripting.FileSystemObject
Dim oCurFile As Object      'Scripting.File
Dim oRegExp As Object       'VBScript_RegExp_55.regExp
Dim oMatches As Object      'VBScript_RegExp_55.MatchCollection
Dim oMatch As Object        'VBScript_RegExp_55.Match
Dim pathSignatures As String
Dim relativePath As String
Dim absolutePath As String
Dim htmlSignature As String
 
    'initialisation
    Set UserSignatures = New Collection
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
        .Pattern = "<[^>]+src=""([^"">]+)"""
        .MultiLine = True
        .Global = True
    End With
 
    'boucler sur tous les fichiers du dossier %APPDATA%\Roaming\Microsoft\Signatures
    pathSignatures = Environ("APPDATA") & "\Microsoft\Signatures"
    For Each oCurFile In oFso.GetFolder(pathSignatures).Files
        'si le fichier est un .htm (signature)
        If LCase(oCurFile.Name) Like "*.htm" Then
            'récupérer le contenu html
            htmlSignature = oFso.OpenTextFile(oCurFile.Path, 1).ReadAll
            'remplacer les path relatifs en path absolus
            Set oMatches = oRegExp.Execute(htmlSignature)
            For Each oMatch In oMatches
                relativePath = oMatch.SubMatches(0)
                absolutePath = oFso.BuildPath(pathSignatures, relativePath)
                If oFso.FileExists(absolutePath) Then
                    htmlSignature = Replace(htmlSignature, "src=""" & relativePath & """", "src=""" & absolutePath & """")
                End If
            Next oMatch
            'ajouter la signature à la collection
            UserSignatures.Add htmlSignature, oFso.GetBaseName(oCurFile.Name)
        End If
    Next oCurFile
 
    Set oFso = Nothing
    Set oCurFile = Nothing
    Set oRegExp = Nothing
    Set oMatches = Nothing
    Set oMatch = Nothing
End Function

Pour l'utiliser, il faudra modifier ton code ainsi en remplaçant "laSignature" par le nom de la signature Outlook.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.HTMLBody = "<html><body>" & var1x & UserSignatures("laSignature") & "</body></html>"

A+

**Kintin** · 09/02/2023, 14h16

Génie!!!

Merci,

signature mail avec image/lien

VBA Outlook

Discussions similaires

Partager

Partager