Sending hyperlink filepath via email

[AndyEd]

I have used the following code to identify a filepath, in the body of an email.

Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
      
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = "C:\TEMPLATE"
    On Error Resume Next
    With OutMail
        .To = "firstname.lastname@emailaddress"
        .Subject = "Testing URL"
        .HTMLBody = strbody
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

The displayed string of text can be added to the address bar in windows explorer, which works fine. However I would like to have this displayed as a hyperlink in the email body, and displayed as a cell value.

So in this instance the cell value of "B11" would be "1/2024" which would be displayed in the email body as a hyperlink, which when clicked would open a folder at address "C:\blah blah"

I have used a https\\: address which displays the full filepath as a hyperlink, however, it utilises sharepoint not explorer, and the full filepath is displayed, not the specified cell value.

Any assistance would be appreciated.

 

[JEC]

How about

Sub jec()
 Dim olItem As Object, wdDoc As Object
 Set olItem = CreateObject("outlook.application").createitem(0)
 Set wdDoc = olItem.GetInspector.WordEditor
 olItem.To = "test"
 olItem.Subject = "test"
 wdDoc.Hyperlinks.Add wdDoc.Range(0, 0), "C:\TEMPLATE\", , , [B11]
 olItem.Display
End Sub

 

[AndyEd]

Hi Jec

I've tweaked it to get it to look how I'd like it.

Could you please explain what the Range(0, 0) relate to?

Thank you,

 

[JEC]

It puts the hyperlink on the first position of the "WordEditor" (body)

 

[AndyEd]

Can anyone please explain why I am getting the following error?

The code is shown below.

Private Sub cmdSendEmail_Click()

    With ThisWorkbook.Worksheets("Memo")
        If .Range("B5") = vbNullString Then
            .Range("B5").Select
            .Range("B5").Interior.Color = RGB(255, 255, 204)
            Exit Sub
        End If
    End With
        
    With ThisWorkbook.Worksheets("Memo")
        If .Range("B7") = vbNullString Then
            .Range("B7").Select
            .Range("B7").Interior.Color = RGB(255, 255, 204)
            Exit Sub
        End If
    End With
    
    With ThisWorkbook.Worksheets("Memo")
        If .Range("B9") = vbNullString Then
            .Range("B9").Select
            .Range("B9").Interior.Color = RGB(255, 255, 204)
            Exit Sub
        End If
    End With
 
    Dim olItem As Object
    Dim wdDoc As Object
    Dim Body As String
 
    Set olItem = CreateObject("outlook.application").createitem(0)
    Set wdDoc = olItem.GetInspector.WordEditor

    Body = "Sample text." & vbCrLf & vbCrLf
 
    olItem.To = ThisWorkbook.Worksheets("Memo").Range("C7") ' This workbook.
    olItem.Subject = "Subject text"
    olItem.Body = Body
    wdDoc.Hyperlinks.Add wdDoc.Range(52, 52), ThisWorkbook.Worksheets("Memo").Range("I11"), , , [B11]
    olItem.Display
    olItem.send
 
    MsgBox "Your selections have been saved and an email has been sent to " & ThisWorkbook.Worksheets("Memo").Range("B7") & ".", vbOKOnly + vbInformation, "Information saved and email sent"
 
    If Workbooks.Count = 1 Then
        ThisWorkbook.Save
        Application.Quit
    Else
        ThisWorkbook.Close SaveChanges:=True
    End If

End Sub

This is the line that is attracting the error. On occasion it works, and every once in a while it randomly doesn't.

Set wdDoc = olItem.GetInspector.WordEditor

Run-time error '-2147467259 (80004005)':
The operation failed.

 

[JEC]

Try it like this.

Sub jec()
 Dim wDoc As Object
 With CreateObject("outlook.application").createitem(0)
    .To = ThisWorkbook.Worksheets("Memo").Range("C7") ' This workbook.
    .Subject = "Subject text"
    .Body = "Sample text." & vbCrLf & vbCrLf
    .Display
     Set wdDoc = .GetInspector.WordEditor
     wdDoc.Hyperlinks.Add wdDoc.Range(52, 52), ThisWorkbook.Worksheets("Memo").Range("I11"), , , [B11]
    '.send
 End With
End Sub

 

[AndyEd]

It is now returning the error message:

Compile error:
Variable not defined

 

[JEC]

Oh a typo. It should be

Dim wdDoc as object

 

[AndyEd]

Yeah, sorry. Couldn't see the wood for the trees...not that there were that many!!