Search code examples
excelvbaoutlookcombobox

How to put email address from column into BCC field of Outlook e-mail based on selection in another column


In Excel, I created buttons and a userform shows up. I have code to select a range of e-mail addresses.

I have on a sheet 3 columns: Name, e-mail address and for every e-mail address a secondary e-mail address which I would like to add to the BCC field.

Combobox1 displays the e-mail address and transfers that to the outgoing mail.
I could not find a way to add the e-mail address in the next column to the BCC field.

For clarity, I would like to select a name (column 1) and that transfers an e-mail address (column 2) to the .To field and another e-mail address (column 3) to the .BCC field.

I tried:

How do I populate a combo box from a column in my excel spread sheet?

populate combobox in VBA with array elements

https://www.codeproject.com/Articles/401098/A-multi-selection-Drop-Down-List-using-a-generic-A

Private Sub CommandButton1_Click()

    Dim AppOutlook As Outlook.application
    Dim Mailtje As Outlook.MailItem

    Set AppOutlook = CreateObject("Outlook.Application")
    Set Mailtje = AppOutlook.CreateItem(olMailItem)
    
    Mailtje.Display
    Mailtje.To = ComboBox1.Value
    Mailtje.CC = TextBox1.Value
    Mailtje.BCC = ?
    Mailtje.Subject = ""
    Mailtje.HTMLBody = ""

End Sub

Private Sub CommandButton2_Click()

    Unload Me
        
End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Initialize()

    Dim N As Long, i As Long
    
    With Sheets("Medewerkers")
        N = .Cells(Rows.Count, 1).End(xlUp).Row
    End With

    With ComboBox1
        .Clear
        For i = 2 To N
            .AddItem Sheets("Medewerkers").Cells(i, 2).Value
        Next i
    End With
End Sub

Solution

  • Expand the ComboBox to all 3 columns and hide 2 if required.

    Option Explicit
    
    Private Sub CommandButton1_Click()
    
        Dim AppOutlook As Outlook.Application
        Dim Mailtje As Outlook.MailItem
        Dim xTo As String, xBCC As String
        Dim i As Long
        
        With Me.ComboBox1
            i = .ListIndex
            If i < 0 Then
                MsgBox "Nothing selected", vbExclamation
                Exit Sub
            End If
            xTo = .List(i, 1)
            xBCC = .List(i, 2)
        End With
        
        Set AppOutlook = CreateObject("Outlook.Application")
        Set Mailtje = AppOutlook.CreateItem(olMailItem)
        With Mailtje
            .To = xTo
            .CC = Sheets("Medewerkers").Range("G2").Value
            .BCC = xBCC
            .Subject = TextBox1.Value
            .HTMLBody = ""
            .Display
        End With
        
    End Sub
    
    Private Sub UserForm_Initialize()
    
        Dim n As Long
        With Sheets("Medewerkers")
            n = .Cells(Rows.Count, 1).End(xlUp).Row
        End With
    
        With ComboBox1
            .Clear
            .ColumnCount = 3
            .ColumnWidths = ";0;0" ' zero width to hide
            .ColumnHeads = True
            .RowSource = "Medewerkers!A2:C" & n
        End With
        
    End Sub