Include network file path as a hyperlink in vba email

[ali_g187]

Hi

I use the following code to give users of a shared workbook the option to email a pre-defined list of people about an update. I'd like to be able to include a hyperlink to the file on our network server in the email where it says 'Please check here', but I'm not sure how. Does anyone have any suggestions?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Save As Boolean)
Dim answer As String

answer = MsgBox("Do you want to notify the team?", vbYesNo, "Email team")
If answer = vbNo Then SaveUI = True
If answer = vbYes Then
'open outlook type stuff
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
'add recipients
'newmsg.Recipients.Add ("Insert name")
newmsg.Recipients.Add ("Insert email address")
'add subject
newmsg.Subject = "Updated document"
'add body
newmsg.Body = "Updated document." & vbCrLf & "" & "Please check here"
newmsg.Display 'display
newmsg.Send 'send message
'give conformation of sent message
MsgBox "Outlook message sent", , "Outlook message sent"

End If

'save the document
'Me.Worksheets.Save
End Sub

[georgiboy]

Have you tried something like this:


newmsg.Body = "Updated document." & vbCrLf & "Please check here <File:\YourFilePath>"

or


newmsg.HTMLBody = "Updated document." & vbCrLf & "Please check here <File:\YourFilePath>"

[ali_g187]

Have you tried something like this:


newmsg.Body = "Updated document." & vbCrLf & "Please check here <File:\YourFilePath>"

or


newmsg.HTMLBody = "Updated document." & vbCrLf & "Please check here <File:\YourFilePath>"


Hi, thanks for your reply. Yes I have and it does work, but for files with a long path name is quite unwieldy. Is it possible to have the word 'here' be a hyperlink to the file path, or am I asking too much.

[georgiboy]

How about:

tmpBody = "Updated document, please check <a href=""YourFilePath"">here</a>"
newmsg.BodyFormat = olFormatHTML
newmsg.HTMLBody = tmpBody

[ya1hazan]

How about:

tmpBody = "Updated document, please check <a href=""YourFilePath"">here</a>"
newmsg.BodyFormat = olFormatHTML
newmsg.HTMLBody = tmpBody


Hi,
I found your simple solution and used it with a similiar problem I have.
I refer to a folder and when folder name includes a blank, the hyperlink "breaks" at the blank.

any solution for that?

[gmayor]

Use the following code as a basis for creating e-mail messages with hyperlinks. It doesn't require a reference to Outlook as it uses Late Binding, but it does require the function from the link at the top of the code.


Option Explicit

Sub AddHyperlink()
'Graham Mayor - https://www.gmayor.com - Last updated - 27 May 2019
'Use the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to start Outlook or the code below doesn't work


Dim olApp As Object
Dim olEmail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim oLink As Object
Dim strLink As String
Dim strLinkText As String
'The texts before and after the link
Const strText1 As String = "If you wish to download or view our latest catalogue, please simply follow this link: " & vbCr & vbCr
Const strText2 As String = vbCr & vbCr & "Should you wish to review or enquire about any of our products, please do not hesitate to get in touch."


Set olApp = OutlookApp()
strLink = "http://www.gmayor.com" ' the link address
strLinkText = "Click here for Graham Mayor's Web Site " ' the link display text


On Error Resume Next
Set olEmail = olApp.CreateItem(0)
With olEmail
.To = "someone@somewhere.com"
.Subject = "This is the subject"
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = strText1
oRng.collapse 0
Set oLink = wdDoc.Hyperlinks.Add(Anchor:=oRng, _
Address:=strLink, _
SubAddress:="", _
ScreenTip:="", _
TextToDisplay:=strLinkText)
Set oRng = oLink.Range
oRng.collapse 0
oRng.Text = strText2
.Display 'Required
'.Send 'Enable after testing
End With
lbl_Exit:
Set olApp = Nothing
Set olInsp = Nothing
Set olEmail = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub