Consulting

Results 1 to 4 of 4

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

  1. #1
    VBAX Regular
    Joined
    Apr 2021
    Posts
    40
    Location

    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?

    Here is the 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 <br></br> 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 & ", " & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A8").Value & " " & Sheet7.Range("G13") & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A10").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A12").Value & "<br></br>" & "<br></br>" & _
                "<br><u><b>Included in Budget</b></u></br>" & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A16").Value & "<br></br>" & _
                Sheet93.Range("A17").Value & "<br></br>" & _
                Sheet93.Range("A18").Value & "<br></br>" & _
                Sheet93.Range("A19").Value & "<br></br>" & _
                Sheet93.Range("A20").Value & "<br></br>" & _
                Sheet93.Range("A21").Value & "<br></br>" & _
                Sheet93.Range("A22").Value & "<br></br>" & "<br></br>" & _
                "<br><u><b>Not Included in Budget</b></u></br>" & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A26").Value & "<br></br>" & _
                Sheet93.Range("A27").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A29").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A31").Value & "<br></br>" & _
                Sheet93.Range("A32").Value & "<br></br>" & _
                Sheet93.Range("A33").Value & "<br></br>" & _
                Sheet93.Range("A34").Value & "<br></br>" & _
                Sheet93.Range("A35").Value & "<br></br>" & _
                Sheet93.Range("A36").Value & "<br></br>" & _
                Sheet93.Range("A37").Value & "<br></br>" & "<br></br>" & Sheet93.Range("A39").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A41").Value & "<br></br>" & Sheet93.Range("A42").Value & "<br></br>" & "<br></br>" & "<br></br>" & Sheet93.Range("A45").Value & "<br></br>" & 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
    Last edited by Ray707; 04-07-2021 at 09:24 AM.

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,954
    Location
    Depends on if it is local/network file or a web link. For the former:
    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 & "<p>" & "<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.

  3. #3
    VBAX Regular
    Joined
    Apr 2021
    Posts
    40
    Location
    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):

    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 <br></br> 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 & ", " & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A8").Value & " " & Sheet7.Range("G13") & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A10").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A12").Value & "<br></br>" & "<br></br>" & _
                "<br><u><b>Included in Budget</b></u></br>" & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A16").Value & "<br></br>" & _
                Sheet93.Range("A17").Value & "<br></br>" & _
                Sheet93.Range("A18").Value & "<br></br>" & _
                Sheet93.Range("A19").Value & "<br></br>" & _
                Sheet93.Range("A20").Value & "<br></br>" & _
                Sheet93.Range("A21").Value & "<br></br>" & _
                Sheet93.Range("A22").Value & "<br></br>" & "<br></br>" & _
                "<br><u><b>Not Included in Budget</b></u></br>" & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A26").Value & "<br></br>" & _
                Sheet93.Range("A27").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A29").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A31").Value & "<br></br>" & _
                Sheet93.Range("A32").Value & "<br></br>" & _
                Sheet93.Range("A33").Value & "<br></br>" & _
                Sheet93.Range("A34").Value & "<br></br>" & _
                Sheet93.Range("A35").Value & "<br></br>" & _
                Sheet93.Range("A36").Value & "<br></br>" & _
                Sheet93.Range("A37").Value & "<br></br>" & "<br></br>" & Sheet93.Range("A39").Value & "<br></br>" & Sheet93.Range("A40").Value & "<br></br>" & "<br></br>" & _
                Sheet93.Range("A41").Value & "<br></br>" & Sheet93.Range("A42").Value & "<br></br>" & "<br></br>" & "<br></br>" & Sheet93.Range("A45").Value & "<br></br>" & Sheet93.Range("A46").Value & _
                eMsg
                body = .HTMLBody
                .HTMLBody = "Body " & vbCrLf & body & "<p>" & "<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):


    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...
    Last edited by Ray707; 04-08-2021 at 03:02 AM.

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,954
    Location
    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 "<br></br> use "<br>". 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:
    Dim s as string
    s="Hello "
    s=s & "World!"
    '....
    .htmlBody=s
    I can show you more string building tips later if that interest you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •