VBA填充列表框上的文本框從Outlook聯繫人點擊

Question

我有下面的代碼填充我的Outlook聯繫人的名稱列表框。我希望在單擊某個項目時將地址輸入到我的表單上的文本框中。只要說，我不知道該怎麼做......任何幫助？

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("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 pt; 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