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