Welcome to Excel Avon
Import Contact from outlook
DOWNLOAD USED EXCEL FILE FROM HERE>>
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.
On opening in VBE, you have to go to Insert and then Module has to be inserted, as can be seen in the image.
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.
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
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.
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.
DOWNLOAD USED EXCEL FILE FROM HERE>>
You can also see well-explained video here about How to Import Contacts from outlook using Excel VBA