Populate textBox on listBox click from Outlook contacts

I have code that populates a listbox with the names of my Outlook contacts.

I'd like when an item is clicked, the address be entered into a textbox on my form.

Private Sub getContacts()

Dim x As Integer
Dim oOutlookApp As Outlook.Application
Dim oOutlookNameSpace As Outlook.NameSpace
Dim oContacts As Outlook.MAPIFolder
Dim oContact As Outlook.ContactItem

  On Error Resume Next

  Set oOutlookApp = GetObject(, "Outlook.Application")
  If Err <> 0 Then
    Set oOutlookApp = CreateObject("Out开发者_开发知识库look.Application")
  End If

  Set oOutlookNameSpace = oOutlookApp.GetNamespace("MAPI")
  'Get the contactfolder
  Set oContacts = oOutlookNameSpace.GetDefaultFolder(olFolderContacts)

  For Each oContact In oContacts.Items
    Me.ListBox1.AddItem oContact.LastNameAndFirstName
    x = x + 1
  
  Next
  
  Set oContact = Nothing
  Set oContacts = Nothing
  Set oOutlookNameSpace = Nothing
  Set oOutlookApp = Nothing

End Sub

On your form, select your listbox and press F4 to show the Properties dialog. Change BoundColumn to 1, ColumnCount to 2, and ColumnWidth to 0 pt; 72pt

We're making two columns, the first to hold the email address, the second to hold the name. The first is hidden. BoundColumn = 1 means that we can use ListBox1.Value to get the value in the first column

You can have stuff in your contacts folder that isn't a contact, so I changed the code a little to account for that

Private Sub GetContacts()

    Dim oOutlookApp As Outlook.Application
    Dim oOutlookNameSpace As Outlook.NameSpace
    Dim oContacts As Outlook.MAPIFolder
    Dim oContact As Outlook.ContactItem
    Dim i As Long

    Set oOutlookApp = New Outlook.Application
    Set oOutlookNameSpace = oOutlookApp.GetNamespace("MAPI")
    'Get the contactfolder
    Set oContacts = oOutlookNameSpace.GetDefaultFolder(olFolderContacts)

    For i = 1 To oContacts.Items.Count
        If TypeName(oContacts.Items(i)) = "ContactItem" Then
            Set oContact = oContacts.Items(i)
            Me.ListBox1.AddItem oContact.Email1Address
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = oContact.LastNameAndFirstName
        End If
    Next i

    Set oContact = Nothing
    Set oContacts = Nothing
    Set oOutlookNameSpace = Nothing
    Set oOutlookApp = Nothing

End Sub

Private Sub ListBox1_Click()

    Me.TextBox1.Text = Me.ListBox1.Value

End Sub

Private Sub UserForm_Activate()

    GetContacts

End Sub