How to Import Contact from outlook using Excel VBA

Welcome to Excel Avon

Import Contact from outlook

In today’s post, we will show you How to Import contact from outlook using Excel VBA, In this post we will work with Module as we created with Module in previous post.

We explained in the previous post, we told how to create contacts in Outlook in Excel VBA, this post is similar to that post, in the previous post, we taught how to import emails from Outlook to Excel sheet, in this we will learn how to import emails from Outlook to Excel VBA. How to import data of all contacts in excel sheet

Like last time we are given a project in which we have to import contact’s first name, sender’s last name, phone numbers, company name and contact’s email, how will we do it if data is required in such project So we will know that in this post, let’s see.

In this way we can import contact from outlook as you are seeing in the image.

How to Import Contact from outlook using Excel VBA

As we taught you how to insert a module when we were working with modules, as we have learned in many posts so far, you can insert modules. Let us teach you how we insert the module. Let’s understand, then we have to go like last time, first go to the Developer Tab, then click on the option of Visual Basic as shown in the image below.

sort-data-on-excel-using-VBA

On opening in VBE, you have to go to Insert and then Module has to be inserted, as can be seen in the image.

Sort-data-on-excel-using-vba

Go to Tools and then select References as shown in the below screenshot. scroll down in the Reference Object library and select “Microsoft Outlook 16.0 Object Library” to make it available for Excel VBA.

Send Email With Outlook automation1

Once the module is inserted, and the library is activated, we’ll write a subroutine to Sub Import Emails().

Sub ImportContacts()
End Sub

We will Declare the variable Outlook Application.

Sub ImportContacts()
Dim olApp As New Outlook.Application
End Sub

Declare the variable for Name space.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
End Sub

Declare the variable for Outlook Mail Items.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
End Sub

Declare the variable for Outlook Folder.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
End Sub

Now we will set here name space, use (MAPI) to return to outlook name space from application.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Set nSpace = olApp.GetNamespace("MAPI")
End Sub

Set folder to return a folder object that represents the default folder of the type requested the currents profile.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)
End Sub

Here we are using For Loop, I have to define another variable which will be for last row.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
Next cItem
End Sub

Here we have to declare the last row where we will import the data.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
     Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
Next cItem
End Sub

Here we will declare row where first name of contact will be imported.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
     Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheet1.Range("A" & Lr).Value = cItem.FirstName
Next cItem
End Sub

Here we will declare the row where the email of the Last name of sender will be imported.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
     Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheet1.Range("A" & Lr).Value = cItem.FirstName
     Sheet1.Range("B" & Lr).Value = cItem.LastName
Next cItem
End Sub

Here we will declare the row where the email of the contact will be imported.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
     Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheet1.Range("A" & Lr).Value = cItem.FirstName
     Sheet1.Range("B" & Lr).Value = cItem.LastName
     Sheet1.Range("C" & Lr).Value = cItem.Email1Address
Next cItem
End Sub

Now we will declare the row where company name of contact will be imported.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
     Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheet1.Range("A" & Lr).Value = cItem.FirstName
     Sheet1.Range("B" & Lr).Value = cItem.LastName
     Sheet1.Range("C" & Lr).Value = cItem.Email1Address
     Sheet1.Range("D" & Lr).Value = cItem.CompanyName
Next cItem
End Sub

Now we will declare the row where phone No. of contact will be imported.

Sub ImportContacts()
Dim olApp As New Outlook.Application
Dim nSpace As Namespace
Dim cItem As ContactItem
Dim cFolder As Outlook.Folder
Dim Lr As Long
Set nSpace = olApp.GetNamespace("MAPI")
Set cFolder = nSpace.GetDefaultFolder(olFolderContacts)

For Each cItem In cFolder.Items
     Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheet1.Range("A" & Lr).Value = cItem.FirstName
     Sheet1.Range("B" & Lr).Value = cItem.LastName
     Sheet1.Range("C" & Lr).Value = cItem.Email1Address
     Sheet1.Range("D" & Lr).Value = cItem.CompanyName
     Sheet1.Range("E" & Lr).Value = cItem.BusinessTelephoneNumber
Next cItem
End Sub

Click on Run button

How to Import Contact from outlook using Excel VBA1

As you can see, the data of the contact has been imported in the required sheet, the data will be visible to you, as shown in the screen, we have shown you more data below. outlook had only two contacts saved so here data is 2.

How to Import Contact from outlook using Excel VBA

Therefore, I hope that you have understood How to Import contacts from outlook using Excel VBA, maybe if you do not understand some options, then you can comment us, which we will answer soon and for more information, you can follow us on Twitter, Instagram, LinkedIn and you can also follow on YouTube.

LEARN MORE TOPIC IN VBA HERE

DOWNLOAD USED EXCEL FILE FROM HERE>>

You can also see well-explained video here about How to Import Contacts from outlook using Excel VBA