Bonjour le forum,

J'ai le code ci-après qui envoi un mail déjà paramétré à des destinataires choisis. Dans ce mail j'ai intégré le chemin d'accès
Code : Sélectionner tout - Visualiser dans une fenêtre à part
G:\S - ISO\H - Projets\Groupe\Q - Projet amelioration struc doc\Obsys\Plan action
indiquant l'emplacement d'un fichier.

Sauf que dans ce mail je souhaiterai activer ce lien qui permettrai ainsi d'accèder directement au fichier. Existe-t-il un code pour activer ce lien ?

Merci.

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
49
Sub Mail_Selection_Range_Outlook_Body()
'programme d'Henry
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
 
 
    Set rng = Nothing
    On Error Resume Next
 
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
 
    On Error GoTo 0
 
    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "d.maufrand@delpeyrat.fr;s.perego@delpeyrat.fr"
        .CC = ""
        .BCC = ""
        .Subject = "Modification dans le plan d'actions d'Obsys"
 
 
        .HTMLBody = "Bonjour," & "<br>" & "" & "<br>" & "Vous recevez ce mail suite à la modification du plan d'action d'Obsys. Cette ou ces modifications concernent la ou les actions ci-après." & "<br>" & "" & "Vous n'êtes pas obligé de répondre à ce mail." & "<br>" & "" & "Vous pouvez y accèder grâce au lien suivant : G:\S - ISO\H - Projets\Groupe\Q - Projet amelioration struc doc\Obsys\Plan action Obsys" & "<br>" & "" & "<br>" & RangetoHTML(rng)
        .Display  'ou utiliser .Sent
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub