insert cell value from excel into body of email

The code below will automatically send emails to users via Outlook.

However I want to add a line in the body of the email which inserts the value of cell B2 from the worksheet that is active when the macro is run.

The line will say: Please open the meeting report using the link below and select the meeting report link called *value of cell B2* found in column E

I have left a space on line 23 of the code snippet where I would like the line to be included.

Option Explicit

Sub SendEmail()
'///Set up the Excel variables.
    Const MsgSignature As String = "Supplier Relationship Team"
    Const sSubj As String = "Supplier Meeting Action Points"
    Dim rCl As Range, rRng As Range
    Dim OLApp As Object, olMailItm As Object
    Dim iCnt As Integer
    Dim sTo As String, sMsg As String

    '///Create the Outlook application and the empty email.
    Set OLApp = CreateObject("Outlook.Application")
    Set olMailItm = OLApp.CreateItem(0)

'http://path/to/Workbook.xls#SheetName!a1

    sMsg = "Hi,<br><br>" & _
           "Please could you complete the action points found on the supplier meeting report (link below) <br><br>" & _
           "Once you have completed your action points please change the status from the drop down list found in column C/D and leave any relevant comments in the STAKEHOLDER COMMENTS column.<br><br>" & _
           "Once completed please click the save & close button at the top of the page.:<br><br>" & _
           "If you have any questions regarding your action points please contact the appropriate category manager found in cell E6 of the sheet.:<br><br>" & _
           
"Click on the link to open the file :<br><br> " & _
           "<A HREF=""file://" & ActiveWorkbook.FullName & "#" & ActiveSheet.Name & "!a1" & _
           """>Link to the file</A>" & _
           "<br><br>Regards," & _
           "<br><br>" & MsgSignature

    '/// create list of recipients

    Set rRng = Range("B86:B93")

    With olMailItm

        For Each rCl In rRng.Cells
            If rCl.Value > 0 Then
                If sTo = "" Then
                    sTo = rCl.Value
                Else
                    sTo = sTo & ";" & rCl.Value
                End If
                iCnt = iCnt + 1
            End If
        Next rCl

        If iCnt < 2 Then
            MsgBox "You nave not entered any recipients.", vbCritical, MsgSignature
            Exit Sub
        End If

        .To = sTo
        .Subject = sSubj
        .HTMLBody = sMsg
           .Display
'        .Send
    End With

    '///Clean up the Outlook application.
    Set olMailItm = Nothing
    Set OLApp = Nothing
End Sub

Select allOpen in new window