VBA compose Outlook e-mail-CodePudding

I'm composing some day-to-day office tools, basic stuff to make may day job a little less click intensive and less switching of programs all together.

In Excel I've created some fancy click-buttons and a userform shows up, so far so good. I got a code to select a range of e-mail addresses. It works fine but here's where my knowledge stops.

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

So I have chosen Combobox1 to display the e-mail address and transfer that to the outgoing mail, but I could not find a way to automate the next column and add that to the BCC field

Below here is my code so far.

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

I have tried these with no success:

The code retreives data from the cells shown here:

And yes, I do like big buttons :)

Private Sub CommandButton1_Click()

    Dim AppOutlook As Outlook.Application
    Dim Mailtje As Outlook.MailItem
    Dim rng As Range
    Dim rng2 As Range
    Dim xTo As String
    Dim xBCC As String
    
    Set rng = Range("A:B")
    Set rng2 = Range("A:C")
    
    xTo = Application.WorksheetFunction.VLookup(ComboBox1.Value, rng, 2, False)
    xBCC = Application.WorksheetFunction.VLookup(ComboBox1.Value, rng2, 3, False)
    
    Set AppOutlook = CreateObject("Outlook.Application")
    Set Mailtje = AppOutlook.CreateItem(olMailItem)
        
    Mailtje.Display
    Mailtje.To = xTo
    Mailtje.CC = Sheets("Medewerkers").Range("G2").Value
    Mailtje.BCC = xBCC
    Mailtje.Subject = TextBox1.Value
    Mailtje.HTMLBody = ""
    

End Sub

Private Sub CommandButton2_Click()

    Unload Me
        
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, 1).Value
        Next i
    End With
End Sub

CodePudding user response：

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