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
From novice to tech pro — start learning today.