Get Data from Contacts Folder in Outlook Automatically

How to get data from the contacts folder in Outlook automatically into an Excel worksheet using VBA. Watch the video below:

Get Data from Contacts Folder in Outlook Automatically

We might need to get details of a specific contact from Outlook or all the contacts details from Outlook. We can perform the task using the export feature from Outlook manually. We can also automate the process of getting the data from the contacts folder in Outlook quickly and easily using VBA. Watch the video tutorial above before diving into the complete VBA code or macro given below:

Sub GetDataFromOutlookContacts()
‘Click on Tools
‘Select References
‘From the new window check the check-box next to Microsoft Outlook Object xx.x Library
‘Click on OK

Dim olApp As Outlook.Application
Dim olNS As Namespace
Dim olMF As MAPIFolder
Dim olItem As Long
Dim sNameSearched As String

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace(“MAPI”) ‘We use GetNameSpace (“MAPI”)
‘to return the Outlook NameSpace object from the Application object.
Set olMF = olNS.GetDefaultFolder(olFolderContacts) ‘The only data source supported is MAPI,
‘which allows access to all Outlook data stored in the user’s mail stores.
‘Messaging Application Programming Interface (MAPI) is an API for Microsoft Windows
‘which allows programs to become email-aware.

Dim lastrow As Long
lastrow = Application.WorksheetFunction.CountA(Range(“A:A”))

Application.ScreenUpdating = False

sNameSearched = InputBox(“Enter the full name of the contact.” & vbCrLf & “Use proper case and correct spelling!”, “ATTENTION”)

If sNameSearched = “” Then
MsgBox “No name entered. Exiting sub!!”
Exit Sub
End If

On Error Resume Next

For olItem = 1 To olMF.Items.Count
With olMF.Items(olItem)

If sNameSearched = .FullName Then

Range("A" & lastrow + 1) = .FullName
Range("A" & lastrow + 1).Offset(0, 1) = .CompanyName
Range("A" & lastrow + 1).Offset(0, 2) = .BusinessAddress
Range("A" & lastrow + 1).Offset(0, 3) = .BusinessTelephoneNumber
Range("A" & lastrow + 1).Offset(0, 4) = .Email1Address

End If

End With
‘lastrow = lastrow + 1
Next olItem

olApp.Quit

Cells.Columns.AutoFit
Sheet1.Cells(lastrow + 1, 1).Select
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
Application.ScreenUpdating = True
End Sub

Get Data from Contacts Folder in Outlook Automatically
Get Data from Contacts Folder in Outlook Automatically

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.