Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Troubleshooting
Research
Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

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

Avatar of Josh House
Josh HouseFlag for United States of America asked on
Microsoft OfficeOutlookMicrosoft ExcelVBA
3 Comments1 Solution142 ViewsLast Modified:
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 


 How do I adjust the code below to accomplish this task? I am very new and still learning.
Carrier-Volume-Rate-Estimate.xlsm
ASKER CERTIFIED SOLUTION
Avatar of Jamie Garroch (MVP)
Jamie Garroch (MVP)Flag of United Kingdom of Great Britain and Northern Ireland imagePowerPoint Technical Consultant

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Commented:
This problem has been solved!
Unlock 1 Answer and 3 Comments.
See Answers