Add code to macro to display different hyperlinks in different emails being sent from excel-CodePudding

How do I add different hyperlinks to excel email body text that goes out to different people? Each email would have a different hyperlink. This is the code I have so far:

Sub Button1_Click()
    Dim rngCell As Range
    Dim Rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strBody As String
    Dim EmailSubject As String
    Dim SendToMail As String
    Dim r As Long
    Application.ScreenUpdating = False
    With ActiveSheet
        If .FilterMode Then .ShowAllData
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set Rng = Range("T5", Cells(Rows.Count, "T").End(xlUp))
    For Each rngCell In Rng
        r = rngCell.Row
       If Range("J" & r).Value = "" And Range("K" & r).Value <> "" And Range("I" & r).Value <= Date Then
            Range("J" & r).Value = Date
            Set OutMail = OutApp.CreateItem(0)
            strBody = "According to my records, your " & Range("A" & r) & Range("S" & r).Value & _
                " contract is due for review. This contract expires " & Range("K" & r).Value & _
                ".  It is important you review this contract ASAP and email me " & _
                "with any changes that are made.  If it is renewed or rolled over, please fill out the " & _
                "Contract Cover Sheet which can be found in the Everyone folder " & _
                "and send me the Contract Cover Sheet along with the new original contract."
            SendToMail = Range("T" & r).Value
            EmailSubject = Range("A" & r).Value
            On Error Resume Next
            With OutMail
                .To = SendToMail
                .CC = "email address removed for privacy reasons"
                .BCC = ""
                .Subject = EmailSubject
                .Body = strBody
            .Display ' You can use .Send
            End With
        End If
    Next rngCell
    Application.ScreenUpdating = True
End Sub

CodePudding user response：

You should be able to just add the hyperlinks that i am guessing are already in cells in your excel sheet. If the links are arranged as such that they are in cells next to the name rows you can just use your current for loops. Just add & Range("INPUT CELL WITH HYPERLINK HERE").value. Should not be a problem for the major part.

If the hyper links are only a few and you need to check whome to send which you can just use and IF condition within the for loop.

CodePudding user response：

In the code you are dealing with a plain text message body:

.Body = strBody

To set up hyperlinks you need to prepare an HTML markup for the message body and then set up the HTMLBody property which returns a string representing the HTML body of the specified item.

The Outlook object model supports three main ways of customizing the message body:

The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:

     Sub CreateHTMLMail() 
       'Creates a new e-mail item and modifies its properties. 
       Dim objMail As Outlook.MailItem 
       'Create e-mail item 
       Set objMail = Application.CreateItem(olMailItem) 
       With objMail 
        'Set body format to HTML 
        .BodyFormat = olFormatHTML 
        .HTMLBody = "<HTML><BODY>Enter the message <a href="http://google.com">text</a> here. </BODY></HTML>" 
        .Display 
       End With 
     End Sub

The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.