Discussion :

[armma]

Bonjour,

Après avoir écumé les différents sites d'entraide Excel, je me tourne vers vous car je reste dans l'impasse.

Objectif : Insérer un lien hypertexte (fixe) dans le corps d'un email.

Alors j'arrive sans problème à créer un lien hypertexte vers une cellule Excel, mais j'ai beau essayer, je n'arrive pas à "affecter" ce lien à une variable, que j'appelle par la suite dans le corps de mon message.

Voici mon code :

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
Private Sub CommandButton1_Click()
Dim MailAd As String
Dim Msg As String
Dim Subj As String
Dim URLto As String
 
 With Sheets("Sheet1")
 
'CE QUE J'AIMERAI FAIRE MAIS QUI NE FONCTIONNE PAS
objLink  = Worksheets("Sheet1").Hyperlinks.Add Anchor:=Selection, Address:="D:\test.gif", SubAddress:="", TextToDisplay:="ici"
 
 
'REMPLISSAGE DES CHAMPS "ADRESSE, SUJET, MESSAGE"
    MailAd = "azeaze@free.fr"
    Subj = "Sujet du message"
    Msg = "Vous trouverez  " & objLink & " les informations souhaitées"
 
'CONSTITUTION ET ENVOI DU MAIL
    URLto = "mailto:" & MailAd & "?subject=" & Subj & "&body=" & Msg
    ActiveWorkbook.FollowHyperlink Address:=URLto
 
End With
End Sub

Maintenant j'aimerais que cela envoie un email avec comme message "Vous trouverez ici les informations souhaitées"

Et le mot "ici" est un lien hypertexte vers le fichier "D:\test.gif"


En vous remerciant d'avance, je vous souhaite un bon appétit !

[kiki29]

Salut, de la lecture http://excel.developpez.com/faq/?page=Messagerie

[armma]

Bonjour kiki29.

Malheureusement les 2 exemples dans le lien que tu as envoyé ne fonctionnent pas.

Le premier me met en dur l'adresse et non en hyperlien.
Le second (méthode CD0) ne fonctionne tout simplement pas (Runtime error)

[armma]

Ca y'est, après je ne sais combien d'heures de recherche, j'ai enfin trouvé.


Voici le code (pris d'un site anglais) pour ceux qui auraient le même problème que moi :

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
Sub mail()
 
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
 
 
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
 
strbody = "body of email" & "<a href=""D:\link.jpg""> ici</a>" & " Thank You"
 
 
On Error Resume Next
With OutMail
.To = "whoever@microsoft.com"
.CC = "(E-Mail Removed)"
.BCC = ""
.Subject = "whatever"
.HTMLBody = strbody
.Display
End With
On Error GoTo 0
 
Set OutMail = Nothing
Set OutApp = Nothing
 
End Sub

Il faut peut être activer la référence Microsoft Outlook si jamais ça vous bugue