Question

在这种情况下，我必须导入组织内部Outlook中的所有联系人，包括nab组或组联系人。我有一些我在某处找到的代码，但这不包括联系人组。这只会导入联系人。

Sub Email_Extract()
Dim colAL As Outlook.AddressLists
Dim oAL As Outlook.AddressList
Dim colAE As Outlook.AddressEntries
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.ExchangeUser
Dim n As Long

Set colAL = Outlook.Application.Session.AddressLists

For Each oAL In colAL
StartTime = Timer

If oAL.AddressListType = olExchangeGlobalAddressList Then

Set colAE = oAL.AddressEntries
    n = 2
        For Each oAE In colAE

            If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then

                Set oExUser = oAE.GetExchangeUser

                ThisWorkbook.Sheets("Sheet1").Cells(n, 1).Value = oExUser.Name 'User Name
                ThisWorkbook.Sheets("Sheet1").Cells(n, 2).Value = oExUser.PrimarySmtpAddress 'SMTP address
                n = n + 1
                Cells(n, 1).Activate
           End if
      Next
  Endif
Next
End sub

请注意，其运行时间取决于组织的电子邮件地址。我找到了一些信息here，但这个想法有点悬而未决。无论如何，我可以在这个过程中包括联系人组吗？请帮忙。感谢。

Answer 1

这是其他类型的提示，因此不要限制为一种类型。

If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then

这演示了如何处理其他类型。（演示代码设置为Outlook而不是Excel。）

Option Explicit

Sub Email_Extract()

Dim colAL As Outlook.AddressLists
Dim oAL As Outlook.AddressList
Dim colAE As Outlook.AddressEntries
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.exchangeUser

Set colAL = Session.AddressLists

For Each oAL In colAL

    If oAL.AddressListType = olExchangeGlobalAddressList Then

        Set colAE = oAL.AddressEntries

        For Each oAE In colAE

            If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then
                'Set oExUser = oAE.GetExchangeUser
                'Debug.Print oExUser.Name

            ElseIf oAE.AddressEntryUserType = olExchangeDistributionListAddressEntry Then
                ' https://msdn.microsoft.com/en-us/library/office/ff868214.aspx
                ' An address entry that is an Exchange distribution list.
                Debug.Print vbCr & "Exchange distribution list - AddressEntryUserType: " & oAE.AddressEntryUserType
                Debug.Print "  " & oAE.Name

            Else
                'Debug.Print vbCr & "? - AddressEntryUserType: " & oAE.AddressEntryUserType
                'Debug.Print "  " & oAE.Name

            End If
        Next
    End If
Next

End Sub

在outlook中导入联系人/ Nab组

1 个答案: