VBAは、リストボックスのclickboxの上にテキストボックスを埋め込みます。

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を0ptに変更します。 72pt

2つの列を作成しています。最初はメールアドレスを保持し、2番目は名前を保持します。最初のものは隠されています。 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