VBA to insert hyperlink to shared file sing Outlook message body

mssbass

Board Regular
Joined
Nov 14, 2002
Messages
235
Platform
  1. Windows
My code will not insert a hyperlink to a shared drive folder. Anyone know what I'm doing wrong?

Sub SendScrubFile()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim txtdate As String
Dim strbody As String
Dim strbody2 As String
Dim strbody3 As String

Set rng = Nothing
On Error Resume Next

Set rng = thisworkbook.sheets("Test").Range("c23:e31").SpecialCells(xlCellTypeVisible)

txtdate = Format(Now, "m") & "/" & Format(Now, "d") & "/" & Format(Now, "yy") & " " & Format(Now, "hAM/PM")
strbody = "Hello Team," & "<br><br>" & _
"Please update grids in the latest shared document within the folder below: <br>" & _
"<a href='//abc.com/Shares/DailyReports'>"

strbody2 = "<br><br>" & "Thank you," & "<br>"
strbody3 = "<BODY STYLE=font-size:11pt;font-family:Calibri>"

On Error Resume Next

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

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

On Error Resume Next
With OutMail
.Display
.To = "xxy@xxy.com"
.CC = ""
.BCC = ""
.Subject = "Scrub Alert " & txtdate
.HTMLBody = strbody3 & strbody & RangetoHTML(rng) & strbody2
.Display 'or use .Send
End With

On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Watch MrExcel Video

Forum statistics

Threads
1,114,580
Messages
5,548,866
Members
410,881
Latest member
toonces
Top