Automated email based on check boxes

[queysoft]

Hello. Currently I use the following code to send emails out via a click box on on of my excel sheets. I was wondering if anyone thinks its possible to have check boxes for different departments (there are 6 departments) and only have the email go to the departments I have ticked?

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"Hi - An update - please see attached." & vbNewLine & _
"Many thanks."
On Error Resume Next
With xOutMail
.To = "XXXXX@X.com"
.CC = "XXXXX@t.com........etc etc"
.BCC = ""
.Subject = "Data Analysis UPDATE"
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[shknbk2]

I put ActiveX checkboxes in column C and made the following test code that prints the email addresses of the checked rows in the Immediate window. Your code could be modified to add them to the To field instead.

Sub EmailsToChecked()
    Dim oleObj As OLEObject
    Dim ws As Worksheet

    Set ws = ActiveSheet
    
    For Each oleObj In ws.OLEObjects
        If oleObj.Object.Value Then
            Debug.Print oleObj.TopLeftCell.Offset(0, 2).Value
        End If
    Next
End Sub