Hi There,

I have a routine below that adds contact folders and subfolders to the
outlook address book (see below) however when I type a partial name and check
names it doesn't resolve- I have to click the To button and find it. If I add
the folders to the outlook address book manually the lookup works. But I
don't want to keep doing that because there are a lot of folders and I setup
outlook on quite a few machines.

Any help / guidance would be great

Tx

Gordon

Sub ShowAsAddressBookChange()
' Variable Declarations
Dim olApp As Outlook.Application
Dim nmsName As Outlook.NameSpace
Dim fldFolder As Outlook.MAPIFolder
' Variable Assignments
Set olApp = Outlook.Application
Set nmsName = olApp.GetNamespace("Mapi") 'Create instance of namespace
Set fldFolder = nmsName.GetDefaultFolder(olFolderContacts)
' Loop to change in each folder and subfolder
For i = 1 To fldFolder.Folders.Count
For j = 1 To fldFolder.Folders(i).Folders.Count
fldFolder.Folders(i).Folders(j).ShowAsOutlookAB = False
Next j
fldFolder.Folders(i).ShowAsOutlookAB = False
Next
End Sub