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

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

VBA在listBox上填充textBox，从outlook联系人中单击

1 个答案: