Link an oulook phonebook to a userform

maramiro

Board Regular
Joined
Mar 17, 2009
Messages
67
How can I link an Microsoft outlook phonebook to a userform in Excel?
so that the user select the name he wants from a phonebook
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Thank you Warship.
All attributes filled in this userform will go to a worksheet called "Result".
Where should i insert the code in order for the info to show in the drop down menu of the userform, the dropbox is called "Ownerbox"?
I have modified the code to match my need, the chnages to the code are noted in "bold". Sorry i m still new to VBA so i might have basic questions. Please let me know if i have missed anything.
Thank you

Sub Import_Contacts()
'Outlook objects.
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olConItems As Outlook.Items
Dim olItem As Object

'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet

'Location in the imported contact list.
Dim lnContactCount As Long

Dim strDummy As String

'Turn off screen updating.
Application.ScreenUpdating = False

'Initialize the Excel objects.
Set wbBook = ThisWorkbook (should it be the saved name of the file?)
Set wsSheet = wbBook.phonebook (the name of the new worksheet that the outlook will import the data on)

'Format the target worksheet.
With wsSheet
.Range("A1").CurrentRegion.Clear
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Title"
.Cells(1, 3).Value = "Business Phone"
.Cells(1, 4).Value = "Location"
.Cells(1, 5).Value = "Department"
.Cells(1, 6).Value = "E-mail Adress"
.Cells(1, 7).Value = "Company"
.Cells(1, 8).Value = "Alias" ( the titiles of my column on the worksheet "phonebook", and it is also the attributes that will be imported from outlook)
With .Range("A1:F1")
.Font.Bold = True
.Font.ColorIndex = 10
.Font.Size = 11
End With
End With

wsSheet.Activate

'Initalize the Outlook variables with the MAPI namespace and the default Outlook folder of the current user.
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(10)
Set olConItems = olFolder.Items

'Row number to place the new information on; starts at 2 to avoid overwriting the header
lnContactCount = 2

'For each contact: if it is a business contact, write out the business info in the Excel worksheet;
'otherwise, write out the personal info.
For Each olItem In olConItems
If TypeName(olItem) = "ContactItem" Then
With olItem
If InStr(olItem.CompanyName, strDummy) > 0 Then
Cells(lnContactCount, 1).Value = .Name
Cells(lnContactCount, 2).Value = .Title
Cells(lnContactCount, 3).Value = .Businessphone
Cells(lnContactCount, 4).Value = .Location
Cells(lnContactCount, 5).Value = .Department
Cells(lnContactCount, 6).Value = .Emailadress
Cells(lnContactCount, 7).Value = .Company
Cells(lnContactCount, 8).Value = .Alias (all bolted titles are the attributes that are shown on the outlook)


End If
wsSheet.Hyperlinks.Add Anchor:=Cells(lnContactCount, 6), _
Address:="mailto:" & Cells(lnContactCount, 6).Value, _
TextToDisplay:=Cells(lnContactCount, 6).Value
End With
lnContactCount = lnContactCount + 1
End If
Next olItem

'Null out the variables.
Set olItem = Nothing
Set olConItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing

'Sort the rows alphabetically using the CompanyName or FullName as appropriate, and then autofit.
With wsSheet
.Range("A2", Cells(2, 6).End(xlDown)).Sort key1:=Range("A2"), order1:=xlAscending
.Range("A:F").EntireColumn.AutoFit
End With

'Turn screen updating back on.
Application.ScreenUpdating = True

MsgBox "The list has successfully been created!", vbInformation

End Sub
 
Upvote 0
The link I posted was meant to be an example of how to import Outlook to Excel.
You will not need all of it. For instance, I doubt you'll need to setup hyperlinks.
The code can be in a Standard Module or in your UserForm and will be run from your UserForm code.

In your UserForm code (probably in UserForm_Initialize) you will set the RowSource attribute of your "Ownerbox" to whatever column(s) you need in the dropdown list.

leave the following as is
Code:
Set wbBook = ThisWorkbook
change the following
Code:
Set wsSheet = wbBook.phonebook
to
Code:
Set wsSheet = wbBook.Sheets("phonebook")
see here: http://msdn.microsoft.com/en-us/library/bb176651(v=office.12).aspx for a list of properties available.
They won't always match what you see in Outlook.

also you will need to set a Reference to Outlook in Excel:
From within the VBE, click Tools | References | scroll to Microsoft Outlook Object Library | check it click ok
 
Last edited:
Upvote 0
Thank you Warship, you ve been very helpful.
I have one more issue, when I write down the code above. it copies the name of the people who are on my "memory" contact list and not all the phonebook.
I need the whole name list of the phonebook.

Thanks again for your fast response!!
 
Upvote 0

Forum statistics

Threads
1,212,042
Messages
6,105,569
Members
447,972
Latest member
carrieann

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top