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
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
