Sub ShowAsAddressBookChange()
 
Dim olApp 'As Outlook.Application
Dim nmsName 'As Outlook.Namespace 
Dim fldFolder 'As Outlook.MAPIFolder 
 
Set olApp = CreateObject("Outlook.Application") 
'Create instance of namespace 
Set nmsName = olApp.GetNamespace("MAPI") 
nmsName.Logon 
'get Contacts 
Set fldFolder = nmsName.GetDefaultFolder(10) 
 
'Display the folder as Outlook Address Book 
fldFolder.ShowAsOutlookAB = True
 
End Sub