VBA заполнить textBox на listBox нажмите из списка контактов Outlook

Question

У меня есть код ниже, который заполняет список с именами моих контактов Outlook.Я хотел бы, чтобы при нажатии на элемент адрес вводился в текстовое поле в моей форме.Достаточно сказать, я не знаю, как это сделать ... любая помощь?

Private Sub getContacts()</p> <pre><code>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("Outlook.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

Answer 1

В форме выберите список и нажмите F4, чтобы открыть диалоговое окно «Свойства». Измените BoundColumn на 1, ColumnCount на 2 и ColumnWidth на 0 пт; 72pt

Мы создаем два столбца: первый содержит адрес электронной почты, второй - имя. Первый скрыт. BoundColumn = 1 означает, что мы можем использовать ListBox1.Value, чтобы получить значение в первом столбце

В папке контактов может быть материал, который не является контактом, поэтому я немного изменил код, чтобы учесть это

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