Sub Mail_link()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Bonjour,<br><br>" & _
"un nouveau document de constatation d'écart envers la sécurité a été enregistré sur le serveur. <br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Cliquez sur le lien suivant pour ouvrir le répertoire : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">D:\test\</A>" & _
"<br><br>Cordialement," & _
"<br><br>Le service de cour</font>"
On Error Resume Next
With OutMail
.To = Range("a51")
.CC = ""
.BCC = ""
.Subject = "Nouveau fichier de constatation d'un écart envers la sécurité"
.HTMLBody = strbody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub