How to create email, adn add hyperlink for workbook filepath?

[Rerock]

Hi!
I'm attempting to put a hyperlink in an automatic email that the recipient can click and go to the folder where the file is located on our network.

There are two tricky parts to this:
1) The path is not a fixed location (the excel file is for pricing bids/quotes, and each project has its own folder).
2) The names of the folders contain spaces.

This code works great provided there are no spaces in the file path:

Sub Send_Email_to_Engineering_For_Review()
'
' Send_Email_to_Engineering_For_Review Macro
'

'ThisWorkbook.Path
 Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = Range("Sheet1!A1")
        .Subject = "Please Review"
        .Body = "file://" & ThisWorkbook.Path
        
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

From my searches, if the filepath contains spaces (which ours does), they need to be replaced with "%20".

Running a test with the current code, the hyperlink breaks at the first 'space', then the remainder of the filepath is simply text (not blue and underlined).

Does anyone know a fix, or have an alternative solution altogether? I'm open to anything as long as it works!

Thanks!

[BuckoAk]

Give this a try.

Sub Send_Email_to_Engineering_For_Review()
'
' Send_Email_to_Engineering_For_Review Macro
'

'ThisWorkbook.Path
 Dim OutApp As Object
    Dim OutMail As Object
    
    strbody = "Click on this link to open the file : " & _
              "<A HREF=""file://" & ActiveWorkbook.FullName & _
                  """>Link to the file</A>"
                  

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = Range("Sheet1!A1")
        .Subject = "Please Review"
        .HTMLBody = strbody
        
                
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[BuckoAk]

If your happy with your answer, be sure to mark you post as [Solved].
At the Top Right of your Post You can:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

You can also give credit by clicking on the Star at the bottom left of the supporting post.

[Mike1001]

Hey BuckoAk, that's great!
It doesn't look perfect, since the prefix and suffix are shown as well in the e-mail, but it works !!!!

[BuckoAk]

Mike,

I didn't catch it at first, what do you mean the prefix and suffix are shown.
Are you not seeing this below (See Image) when the email is created? Did you adjust the code by chance?

[BuckoAk]

If your happy with your answer, be sure to mark you post as [Solved].
At the Top Right of your Post You can:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

You can also give credit by clicking on the Star at the bottom left of the supporting post.