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

Open in new window

mikes6058Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rob HensonFinance AnalystCommented:
Set the link to a variable earlier in the script, eg called FileLink and then at the end of line 22or start of line 23 just include "& FileLink"

Use syntax:

FileLink = Range("B2").Value

Thanks
Rob H
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mikes6058Author Commented:
Thanks Rob,

Would you mind demonstrating with the code I've provided so I can see where to insert the variable?

Mike
0
Saurabh Singh TeotiaCommented:
Use this code..

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>" & _
cells(2,2).value & _           
"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

Open in new window


Saurabh...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.