VBA - Извлечение контактов Outlook
Статья Даниэля Пино - https://www.devhut.net/2019/07/15/vba-extract-outlook-contacts/

Помогая с вопросами на форуме относительно очень ограниченной информации, возвращаемой при использовании External Data -> Import & Link -> More -> Outlook Folder. Обычно указываю, что VBA дает вам возможность получить более расширенную информацию. Это верно при взаимодействии с Outlook and Outlook Contacts. Ниже приведено начало процедуры извлечения любой информации из папки «Контакты».

'---------------------------------------------------------------------------------------
' Procedure : Outlook_ExtractContacts
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract contact information from Outlook
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Usage:
' ~~~~~~
' Call Outlook_ExtractContacts
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-07-15              Initial Release - Forum Help
'---------------------------------------------------------------------------------------
Sub Outlook_ExtractContacts()
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oFolder               As Object    'Outlook.folder
    Dim oItem                 As Object
    Dim oPrp                  As Object
    Const olFolderContacts = 10
    Const olContact = 40
 
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo Error_Handler
 
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oFolder = oNameSpace.GetDefaultFolder(olFolderContacts)
 
    On Error Resume Next
    For Each oItem In oFolder.Items
        With oItem
            If .Class = olContact Then
                Debug.Print .EntryId, .FullName, .FirstName, .LastName, .CompanyName
                For Each oPrp In .ItemProperties
                    Debug.Print , oPrp.Name, oPrp.Value
                Next oPrp
            End If
        End With
    Next oItem
 
Error_Handler_Exit:
    On Error Resume Next
    If Not oPrp Is Nothing Then Set oPrp = Nothing
    If Not oItem Is Nothing Then Set oItem = Nothing
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Outlook_ExtractContacts" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub

Я использую On Error Resume Next, чтобы иметь возможность перебирать все ItemProperties без сбоев моего кода (чтобы показать вам, какая информация на самом деле доступна для вас). Но если Вам нужны только отдельные поля, то Вам лучше просто указать конкретные поля, как я сделал в строке

Debug. Печать .EntryId, .FullName, .FirstName, .LastName, .CompanyName

-------------------------------------------------------------
А ты вложил уже свой кровный рубль в 50-ти миллиардное состояние Билла Гейтса?

https://www.sql.ru/forum/1315163/vba-izvlechenie-kontaktov-outlook