Contacten Outlook exporteren

Sub GetEmailAddresses()
    Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
    Dim olFolder As Outlook.MAPIFolder
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    Dim Item As Object
    
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Object
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    xlApp.workbooks.Add
    Set xlSheet = xlApp.Activeworkbook.Activesheet
    
    For Each Item In olFolder.Items
        If TypeOf Item Is Outlook.MailItem Then
            Dim oMail As Outlook.MailItem: Set oMail = Item
            If Left(oMail.SenderEmailAddress, 1) <> "/" Then
                i = i + 1
                xlSheet.Cells(i, 1) = oMail.SenderEmailAddress
            End If
        End If
    Next
End Sub