how to add hyperlink into the body of an email via VBA?

Hello,

I have a code that sends out emails to stakeholders attaching an excel file. I want to include a URL in the emails to direct stakeholders to one of our policies on our intranet. Ideally it would show the link as a text such as 'here' and not the file path e.g. 'the policy can be found on the intranet here'. I have tried to find a way of doing this but have been unsuccessful, can anyone help please? :thumb

Here is the code:

Code:

Sub ClientUnder() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object 'indicates whether action is shown on scree (like excel pop up) With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copys the ActiveSheet to a new workbook Sheet7.Copy Set Destwb = ActiveWorkbook 'Determines the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsx": FileFormatNum = 51 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End With ' 'Changes all cells in the worksheet to values With Destwb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False 'Saves the new workbook, Mails it then Deletes it TempFilePath = Environ$("temp") & "\" TempFileName = Sheet7.Name & " " & Sourcewb.Name Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail 'use for new line, put text inbetween and & _ @ the end as it indicates that the command isnt finished .to = Sheet7.Range("M4") .CC = Sheet93.Range("R1") .BCC = Sheet93.Range("R2") .Subject = Sheet7.Range("A5") & " " & Sheet7.Range("A7") & " " & Sheet7.Range("A6") .htmlBody = Sheet93.Range("A6").Value & " " & Sheet7.Range("A8").Value & ", " & " " & " " & _ Sheet93.Range("A8").Value & " " & Sheet7.Range("G13") & " " & " " & _ Sheet93.Range("A10").Value & " " & " " & _ Sheet93.Range("A12").Value & " " & " " & _ " Included in Budget" & " " & " " & _ Sheet93.Range("A16").Value & " " & _ Sheet93.Range("A17").Value & " " & _ Sheet93.Range("A18").Value & " " & _ Sheet93.Range("A19").Value & " " & _ Sheet93.Range("A20").Value & " " & _ Sheet93.Range("A21").Value & " " & _ Sheet93.Range("A22").Value & " " & " " & _ " Not Included in Budget" & " " & " " & _ Sheet93.Range("A26").Value & " " & _ Sheet93.Range("A27").Value & " " & " " & _ Sheet93.Range("A29").Value & " " & " " & _ Sheet93.Range("A31").Value & " " & _ Sheet93.Range("A32").Value & " " & _ Sheet93.Range("A33").Value & " " & _ Sheet93.Range("A34").Value & " " & _ Sheet93.Range("A35").Value & " " & _ Sheet93.Range("A36").Value & " " & _ Sheet93.Range("A37").Value & " " & " " & Sheet93.Range("A39").Value & " " & " " & _ Sheet93.Range("A41").Value & " " & Sheet93.Range("A42").Value & " " & " " & " " & Sheet93.Range("A45").Value & " " & Sheet93.Range("A46").Value & _ eMsg .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 .Close savechanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

Depends on if it is local/network file or a web link. For the former:

Code:

Sub email() Dim body As String With CreateObject("Outlook.Application").CreateItem(0) .To = "ken@gmail.com" .Subject = "Test Click Here (Notepad.exe)" .Display body = .HTMLBody .HTMLBody = "Body " & vbCrLf & body & "" & "<a href=""File://c:/Windows/Notepad.exe"">Click Here</a>" .Display '.Send End With End Sub

If the latter, put the url between the double quotes.

Kenneth thank you, that worked! But there are two problems; firstly, at the top of the email it now says the word 'body' and secondly, the 'click here' link is at the bottom of the email.

Let me show you where I put your suggestions in my code (see bold):

Code:

Sub ClientUnder() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object 'indicates whether action is shown on scree (like excel pop up) With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copys the ActiveSheet to a new workbook Sheet7.Copy Set Destwb = ActiveWorkbook 'Determines the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsx": FileFormatNum = 51 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End With ' 'Changes all cells in the worksheet to values With Destwb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False 'Saves the new workbook, Mails it then Deletes it TempFilePath = Environ$("temp") & "\" TempFileName = Sheet7.Name & " " & Sourcewb.Name Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail 'use for new line, put text inbetween and & _ @ the end as it indicates that the command isnt finished .to = Sheet7.Range("M4") .CC = Sheet93.Range("R1") .BCC = Sheet93.Range("R2") .Subject = Sheet7.Range("A5") & " " & Sheet7.Range("A7") & " " & Sheet7.Range("A6") .HTMLBody = Sheet93.Range("A6").Value & " " & Sheet7.Range("A8").Value & ", " & " " & " " & _ Sheet93.Range("A8").Value & " " & Sheet7.Range("G13") & " " & " " & _ Sheet93.Range("A10").Value & " " & " " & _ Sheet93.Range("A12").Value & " " & " " & _ " Included in Budget" & " " & " " & _ Sheet93.Range("A16").Value & " " & _ Sheet93.Range("A17").Value & " " & _ Sheet93.Range("A18").Value & " " & _ Sheet93.Range("A19").Value & " " & _ Sheet93.Range("A20").Value & " " & _ Sheet93.Range("A21").Value & " " & _ Sheet93.Range("A22").Value & " " & " " & _ " Not Included in Budget" & " " & " " & _ Sheet93.Range("A26").Value & " " & _ Sheet93.Range("A27").Value & " " & " " & _ Sheet93.Range("A29").Value & " " & " " & _ Sheet93.Range("A31").Value & " " & _ Sheet93.Range("A32").Value & " " & _ Sheet93.Range("A33").Value & " " & _ Sheet93.Range("A34").Value & " " & _ Sheet93.Range("A35").Value & " " & _ Sheet93.Range("A36").Value & " " & _ Sheet93.Range("A37").Value & " " & " " & Sheet93.Range("A39").Value & " " & Sheet93.Range("A40").Value & " " & " " & _ Sheet93.Range("A41").Value & " " & Sheet93.Range("A42").Value & " " & " " & " " & Sheet93.Range("A45").Value & " " & Sheet93.Range("A46").Value & _ eMsg body = .HTMLBody .HTMLBody = "Body " & vbCrLf & body & "" & "<a href=""www.test.com"">Click Here</a>" .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 .Close savechanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

The email looks like this now (notice the word 'body' is right at the beginning and 'click here' is at the end of the email):

Quote:

Body Hi John,

Please find attached the spend file.

Can you please review the spend and let me know if any of the costs should be moved.

The Expenses Guidelines and Policy can be found on the intranet in the link below:
2020 Expenses Guidelines.pdf

Thanks,
Joe

Joe Bloggs,
Management Accountant
Click Here

I want the 'click here' to be where it says '2020 Expenses Guidelines.pdf' and do not want the word 'body' at the beginning of the email...

Concatenate however you like to build your string for .htmlBody.

#2 was just a simple example. The "Body" was just an example string. Body variable contains your signature if you insert it by default. The last part is the html tag syntax string for a hyperlink. Put it anywhere in your many concatenated string.

Your string could be made more concise. Rather than " use " ". I would use a 2nd With to avoid the use of Sheet93 so much. You don't even need a sheet reference if it is the ActiveSheet. Rather than spanning multiple lines, I would build the string earlier in the macro and just do this sort of thing:

Code:

Dim s as string s="Hello " s=s & "World!" '.... .htmlBody=s

I can show you more string building tips later if that interest you.