Code macro VBA dans Excel pour mettre un Hyperlien dans le corps du message d'un mail

Version imprimable

Bonjour à tous,

Je suis nouveau sur le site et viens de commencer à coder en VBA il y a peu.

Je m'addresse à vous car je n'ai pas pu trouver de solutions à mon problème sur le net, étant donné que mon problème est très spècifique.

Voilà le but de ma macro sous Excel est de faire remplir par l'utilisateur sur Excel une adresse mail cible, un sujet, et surtout dans le corps du message: un Hyperlien ( Hyperlink en anglais )

Ce lien est ajouté de la façon classique : clique droit sur la cellule, Hyperlink ...> etc.

Ensuite, par le biais d'un bouton relié à ma macro, un mail est envoyé à l'adresse mail cible, et dans le corps du texte figure le fameux hyperlink

présenté de la façcon suivante : " Veuillez trouver le fichier ici " avec " ici " possédant le lien vers le répertoire précisé dans le feuillet Excel initial.

Le code d'envoi par mail fonctionne, de même que ma macro mais le problème est qu'elle ne fonctionne que si l'addresse précisée dans le lien ne possède pas d'espaces. J'ai lu sur des forum que la solution consiste à bien mettre les < > pour que le message prennent en compte une adresse mais rien ni fait, j'ai essayé et ça ne fonctionne pas.

Voici sans plus attendre mon code afin que vous puissiez aborder le problème :
Code:

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 Sub Macro_test() Dim ol As New Outlook.Application Dim olmail As MailItem DimStrbody As String Dim Lien As String Set ol = New Outlook.Application Set olmail = ol.CreateItem(olMailItem) Lien = Range("D7") Strbody = " Bonjour, veuillez trouver le répertoire dans le " & "<a href=" & Lien & "> lien suivant. </a> " & " Merci " With olmail .To = Range("D5") .CC = "" .Subject= Range("D6") .HTMLBody = Strbody .Display End With End Sub
Voilà ce code fonctionne mais pas avec des addresses de répertoire contenants un espace. Après avoir essayé beaucoup de choses différentes je ne parviens tourjours pas à le faire fonctionner quelque soit l'adresse, sachant que modifier toutes les addresses n'est pas une option.

Merci beaucoup pour votre aide

Bonjour Julien S,

J'avoue ne pas bien comprendre puisque avec le code ci-dessous, tout fonctionne de mon côté...

Code:

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
Option Explicit
 
Sub Macro_test()
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim Strbody As String
Dim Lien As String
 
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
 
With Worksheets("Feuil1")
    Lien = .Range("D7")
 
    Strbody = "Bonjour, veuillez trouver le répertoire dans le " & "<a href=" & Lien & "> lien suivant. </a> " & " Merci "
End With
 
With olmail
      .To = Range("D5")
      .CC = ""
      .Subject = Range("D6")
      .HTMLBody = Strbody
      .Display
End With
 
End Sub

Peut-être devrais-tu réessayer ?

Cordialement,
Kimy

26/02/2015, 14h31
Julien S

Le code fonctionne bel est bien mais uniquement avec des adresses de répertoires ne possèdant pas d'espaces dans les noms. Créer toi un fichier dans tes documents et appelle le d'un nom avec un espace comme " fichier test " et crée dans la cellule cible un hyperlink vers l'interieur de ce fichier et tu verras que ça ne fonctionne pas, il apparait un message d'erreur

merci de la réponse
26/02/2015, 15h28
vinc_bilb

Bonjour,

Essayez de remplacer les espaces par des %20 .... suggestion

et un bout de code que j'utilise depuis longtemps, si ça peut servir... J'avais oublié le FullNameURLEncoded

Code:

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
49
Sub SEND_WBK(Wbk As Workbook, Signature As String)
    Subname = "SEND_WBK"
 
    Dim Msganswer As String, Msgprompt As String
    Dim Mailsubj As String, Msbd As String, Emailadd As Variant, tolist As String, cclist As String
    Dim Sentwbkfullname       As String, Extrwbkfullname As String, Hlinkaddr As String
    Dim oOApp, oOMail, olMailItem
 
    Emailadd = GET_EMAIL_LIST("T_EMAILLST")
    If UBound(Emailadd) > 0 Then
        tolist = Emailadd(0)
        cclist = Emailadd(1)
    End If
 
    Extrwbkfullname = Wbk.FullName
 
    Mailsubj = "Published: " & Wbk.Name & " (" & Format(DateValue(Now()), "dd-mmm-yy") & ")"
 
'Building Message head
    Hlinkaddr = Wbk.FullNameURLEncoded
 
    Msbd = "<p> Please, find attached extract generated by " & Application.UserName & "</a> </p>"
'    Msbd = Msbd & "<p><tr>"
    Msbd = Msbd & " <p>From master file: " & Wbk.Name & "</b> </p>"
    Msbd = Msbd & "<p> Extract File: <a href=" & "'" & Hlinkaddr & "'> " & " " & Wbk.Name & "</a> </p>"
    Msbd = Msbd & "<p> Directory   : <a href=" & "'" & ActiveWorkbook.Path & "'> " & " " & Wbk.Path & "</a> </p>"
    Msbd = Msbd & "<p><tr>"
    Msbd = Msbd & "Thanks and Best Regards. "
    Msbd = Msbd & "<br>"
    If Signature <> "" Then Msbd = Msbd & "<p><tr>" & Signature & "<br>"
    Msbd = Msbd & " (Automatic email notification)"
 
    Msbd = Msbd & "<p> Free comments from sender: "
 
'Sending Mail
    Set oOApp = CreateObject("Outlook.Application")
    Set oOMail = oOApp.CreateItem(olMailItem)
 
    With oOMail
        .To = tolist
        .CC = cclist
        .Subject = Mailsubj
        .HTMLBody = Msbd
        .Attachments.Add Wbk.FullName
'        .Save
        .Display
    End With
 
End Sub

26/02/2015, 15h48
Kimy_Ire

Ou tout simplement :

Code:

Strbody = "Bonjour, veuillez trouver le répertoire dans le " & "<a href=""" & Lien & """> lien suivant.</a> " & " Merci "

:ccool:

Cordialement,
Kimy

EDIT : le "%20" suggéré vinc_bilb fonctionne également. :ccool: Donc Lien = Replace(.Range("D7"), " ", "%20") fonctionne également !
Par contre, pas les deux ensembles, hein ? :aie:
26/02/2015, 16h22
Julien S

Merci à tous et surtout à Kimy_Ire , ta dernière méthode avec les doubles cotes en plus a parfaitement fonctionné ;)

je ne sais pas pourquoi ces doubles cotes ont pu changer l'interprétation d'Outlook de l'Hyperlien mais je mets le sujet en tant que résolu ;)
26/02/2015, 16h42
Kimy_Ire

En fait, une balise a href s'écrit comme ceci :
<a href="Adresse ou URL"> ... </a>

Or, tu mettais ceci "<a href=" & Lien & ">.

En bref, tu dis à VBA "Insère dans ma String <a href= puis ce que tu trouves dans Lien et enfin > lien suivant. </a>.
Donc tu n'as pas de quote (") dans ta string.

Pour insérer des quotes dans une String, VBA interprète la double quote : "".
Donc si tu mets une triple quote, tu auras la double signifiant "je veux mettre une quote dans ma String" et une quote signifiant "fin de mon insertion dans ma String".

Je ne sais pas si c'est clair pour toi, mais oriente toi vers la FAQ. :ccool:

Cordialement,
Kimy

Et : - - :yaisse1: :aie: