挂起联系人项目查询的Outlook通讯组列表

Phr*_*cis 6 vba outlook-vba

我正在使用MSDN上的一些教程来学习为Outlook制作一些宏.我有这个子程序挂起Type mismatch错误.在单步执行错误处理后Stop,Resume它将返回Next并完成查询.

查看立即中的结果集,缺少一个项目,这实际上是分发邮件列表而不是正常联系人.我将邮件列表从我的联系人中移出进行测试,但错误没有发生.

我也计划有其他邮件列表,因为这是为了工作.除了将它们保存在其他地方之外,是否有某种解决方法可以逃脱它?

这是代码:

Sub ContactName()

    On Error GoTo ErrHandler

    Dim ContactsFolder As Folder
    Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
    MsgBox ("Contacts found: " & ContactsFolder.Items.Count)

    Dim Contact As ContactItem
    For Each Contact In ContactsFolder.Items
        Debug.Print Contact.CompanyName
    Next
    Exit Sub

ErrHandler:
    Debug.Print Err.Description
    Stop
    Resume

End Sub
Run Code Online (Sandbox Code Playgroud)

Dea*_*nOC 3

为了区分列表和联系人,您可以将代码更改为以下内容:

Sub ContactName()

On Error GoTo ErrHandler

Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
MsgBox ("Contacts found: " & ContactsFolder.Items.Count)

Dim Contact As ContactItem
Dim distList As DistListItem
Dim i As Integer

For i = 1 To ContactsFolder.Items.Count

    If TypeOf ContactsFolder.Items(i) Is DistListItem Then
      Set distList = ContactsFolder.Items(i)
      Debug.Print distList.DLName
    ElseIf TypeOf ContactsFolder.Items(i) Is ContactItem Then
      Set contact = ContactsFolder.Items(i)
      Debug.Print contact.FullName
    Else
      Debug.Print "Item is something else"
    End If

Next i
Exit Sub

ErrHandler:
    Debug.Print Err.Description
    Stop
    Resume

End Sub
Run Code Online (Sandbox Code Playgroud)

请注意,我将要访问的属性从 CompanyName 更改为 FullName 以进行测试,因为我没有所有联系人的 CompanyName。