Link userform to the outlook global address list

maramiro

Board Regular
Joined
Mar 17, 2009
Messages
67
Hello,
I have a userform and i m trying to link the contact dropbox of the userform to the outlook global adress list.
the following code doesnt give me the global adress list, it only provides me my personnel contact list.
Does anyone know how to twist the code to make it global instead of personnel.

Thank you
Code:
Private Sub UserForm_Initialize()
'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
Set wsSheet = wbBook.Sheets("phonebook")

'Format the target worksheet.
With wsSheet
.Range("A1").CurrentRegion.Clear
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Title"
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;
For Each olItem In olConItems
If TypeName(olItem) = "ContactItem" Then
With olItem
If InStr(olItem.CompanyName, strDummy) > 0 Then
Cells(lnContactCount, 1).Value = .LastNameAndFirstName
Cells(lnContactCount, 2).Value = .JobTitle

End If
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:B").EntireColumn.AutoFit
End With
'Turn screen updating back on.
Application.ScreenUpdating = True
Worksheets("MENU").Select

End Sub
 

Some videos you may like

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Here's some code that uses a TextBox that displays the GAL when clicked:

Code:
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim cdoSession, cdoAddressBook, olkRecipients, objAE
    On Error Resume Next
    Set cdoSession = CreateObject("MAPI.Session")
'   Change the name of your Outlook profile as needed.
    cdoSession.Logon "", "", False, False
    Set olkRecipients = cdoSession.AddressBook(, "Global Address List", 0, False)
    For Each objAE In olkRecipients
        TextBox1.Text = objAE.Name
    Next
    Set olkRecipients = Nothing
    cdoSession.Logoff
    Set cdoSession = Nothing
End Sub
 

maramiro

Board Regular
Joined
Mar 17, 2009
Messages
67
Thank you for the fast reply.
I have selected the ownerbox and the mouse down option and wrote the code above and I changed the "textbox1" name with "ownerbox" because this is the name of my dropbox.
But it is not working, it still doesnt show me all the names, only my personnel contact. Sorry i m still new to the VBA code.
Thank you
 
Last edited:

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Add a TextBox to your UserForm, name it TextBox1 and use the code I posted. When you click the TextBox do you see the GAL?
 

maramiro

Board Regular
Joined
Mar 17, 2009
Messages
67

ADVERTISEMENT

Thank you, I did create a textbox1 like you have requested.
But i dont see the Global Adress List when i click on the textbox.
 

maramiro

Board Regular
Joined
Mar 17, 2009
Messages
67

ADVERTISEMENT

ya i have put it under the userform, and then i have selected

"""" Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
"""" from the drop box menu of the userform module.

but i dont get any messages back, no error either.
I dont see the GAL when i click on the box.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Let's start from scratch.

Open a new workbook and insert a Userform. Add a TextBox to the UserForm. Paste the code I posted into the UserForm module. Run the UserForm and click in the TextBox. Do you see the GAL? I do.
 

maramiro

Board Regular
Joined
Mar 17, 2009
Messages
67
I m sorry,
I dont see it. I opened a new worksheet, created a userform with a textbox, i clicked on the userform and inserted the code. when i run it and click on the textbox, i dont see anything.

I have an outlook 2010 and an Excel 2010.
I have also crossed Microsoft outlook 14.0 object library from the tools/references of the VBA. I dont know if I should be crossing anything else.

thanks for your patience.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
The code uses CDO not Outlook. What happens if you comment out this line?

Code:
On Error Resume Next
 

Watch MrExcel Video

Forum statistics

Threads
1,122,514
Messages
5,596,610
Members
414,080
Latest member
penguin23

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
Top