Link userform to the outlook global address list

[maramiro]

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

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

 

[maramiro]

Nothing happens, i still dont get any messages or errors.

 

[Andrew Poulsom]

Are you sure that the code is firing? What if you add a breakpoint somewhere?

 

[maramiro]

I had inserted a break on the for loop, but nothing shows other than the userform.
Even if i put breaks all over the code, nothing shows other than the userform. In other words, i dont see the breaks getting "highlighted" yellow.

 

[Andrew Poulsom]

Are you clicking in the TextBox?

 

[maramiro]

Yes, i clicked on it and I tried to type an existing name in my outlook GAL.

 

[Andrew Poulsom]

If you have a GAL you should get a popup just like you do in Outlook. Does this standalone macro work for you?

Sub Test()
    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
        MsgBox objAE.Name
    Next
    Set olkRecipients = Nothing
    cdoSession.Logoff
    Set cdoSession = Nothing
End Sub

 

[maramiro]

no, still not working.
I had inserted the code in a module by itself.
and clicked on the textbox of the userform. Something is just weird, if it works with you and not me.

 

[maramiro]

how about the code i had posted at the begining?
It works but the only thing is it gives me my personnel contact and not my GAL contact.

 

[Andrew Poulsom]

What happens if you delete or comment out this line in my Test macro?

On Error Resume Next

 

[maramiro]

I commented out the line above. and it gave me an error saying "" Run-time error '429': Activex component cant create object".
I had copy paste the code in a new module not in the userform module.
it is also a new workbook that i had created a userform for from skratch.


and the following line is highlighted yellow

Set cdoSession = CreateObject("MAPI.Session")