Add Checkboxes that will return emails addresses in the BCC field into Outlook

I am building an email in Excel for Outlook using the following code:

 I want to use check boxes (using the form controls) to decide whether an email is used.  If the check box reference cell is true input the value of a cell (an email address) into the BCC field.

 If Cell H4=True return Cell F4. (If the check box is marked then it will show a value of true if not a value of false)

 Going down a list of about 30 entries so this needs to loop until there are no more check boxes

1:Sub Mail_Selection_Range_Outlook_Body()
2:'Don't forget to copy the function RangetoHTML in the module.
3:'Working in Excel 2000-2016
4:Dim rng As Range
5:Dim OutApp As Object
6:Dim OutMail As Object
7:
8:Set rng = Nothing
9:On Error Resume Next
10:'Only the visible cells in the selection
11:'Set rng = Selection.SpecialCells(xlCellTypeVisible)
12:'You can also use a fixed range if you want
13:Set rng = Sheets("Volume Template").Range("K4:L14").SpecialCells(xlCellTypeVisible)
14:On Error GoTo 0
15:
16:If rng Is Nothing Then
17:MsgBox "The selection is not a range or the sheet is protected" & _
18:vbNewLine & "please correct and try again.", vbOKOnly
19:Exit Sub
20:End If
21:
22:With Application
23:.EnableEvents = False
24:.ScreenUpdating = False
25:End With
26:
27:Set OutApp = CreateObject("Outlook.Application")
28:Set OutMail = OutApp.CreateItem(0)
29:
30:On Error Resume Next
31:With OutMail
32:.To = ""
33:.CC = ""
34:.BCC =
35:.Subject = "UTS VOLUME QUOTE REQUEST"
36:.HTMLBody = RangetoHTML(rng)
37:.Display 'or use .Send
38:End With
39:On Error GoTo 0
40:
41:With Application
42:.EnableEvents = True
43:.ScreenUpdating = True
44:End With
45:
46:Set OutMail = Nothing
47:Set OutApp = Nothing
48:End Sub
49:
50:
51:Function RangetoHTML(rng As Range)
52:Dim fso As Object
53:Dim ts As Object
54:Dim TempFile As String
55:Dim TempWB As Workbook
56:
57:TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
58:
59:'Copy the range and create a new workbook to past the data in
60:rng.Copy
61:Set TempWB = Workbooks.Add(1)
62:With TempWB.Sheets(1)
63:.Cells(1).PasteSpecial Paste:=8
64:.Cells(1).PasteSpecial xlPasteValues, , False, False
65:.Cells(1).PasteSpecial xlPasteFormats, , False, False
66:.Cells(1).Select
67:Application.CutCopyMode = False
68:On Error Resume Next
69:.DrawingObjects.Visible = True
70:.DrawingObjects.Delete
71:On Error GoTo 0
72:End With
73:
74:'Publish the sheet to a htm file
75:With TempWB.PublishObjects.Add( _
76:SourceType:=xlSourceRange, _
77:Filename:=TempFile, _
78:Sheet:=TempWB.Sheets(1).Name, _
79:Source:=TempWB.Sheets(1).UsedRange.Address, _
80:HtmlType:=xlHtmlStatic)
81:.Publish (True)
82:End With
83:
84:'Read all data from the htm file into RangetoHTML
85:Set fso = CreateObject("Scripting.FileSystemObject")
86:Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
87:RangetoHTML = ts.readall
88:ts.Close
89:RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
90:"align=left x:publishsource=")
91:
92:'Close TempWB
93:TempWB.Close savechanges:=False
94:
95:'Delete the htm file we used in this function
96:Kill TempFile
97:
98:Set ts = Nothing
99:Set fso = Nothing
100:Set TempWB = Nothing
101:End Function 

Select allOpen in new window

 How do I adjust the code below to accomplish this task? I am very new and still learning.
Carrier-Volume-Rate-Estimate.xlsm