Add Outlook Contacts login script

[Reedler]

I am using the below login script to add three public contact folders to
favorites and the outlook address boot. I only need this script to run if the
contacts have not been added to the favorites and address book. I cant figure
out what code to use to check to see if the conacts have been added to
favorites and skip to the end of the script so it wont run every time. Thanks!

' Listing 9.6 Adding a Public Folder to Favorites
'================================================
' path to public folder Bacova Contacts
strFolder = "Public Folders\All Public Folders\Bacova Contacts"
Call AddFolderToFavorites(strFolder, True)

' path to public folder Bacova Lacey Plant Contacts
strFolder = "Public Folders\All Public Folders\Bacova Lacey Plant"
Call AddFolderToFavorites(strFolder, True)

' path to public folder Gulistan Contacts
strFolder = "Public Folders\All Public Folders\Gulistan Contacts"
Call AddFolderToFavorites(strFolder, True)

Sub AddFolderToFavorites(strPath, AddToAddressBook)
Const olContactItem = 2
Set myFolder = GetFolder(strPath)
If Not myFolder Is Nothing Then
myFolder.AddToPFFavorites
' if contacts folder,
' optionally add new Favorite to OAB
If myFolder.DefaultItemType = olContactItem Then
If AddToAddressBook = True Then
strFavFolder = _
"Public Folders\Favorites\" & _
myFolder.Name
Set myFavFolder = GetFolder(strFavFolder)
If Not myFavFolder Is Nothing Then
myFavFolder.ShowAsOutlookAB = True
End If
End If
End If
End If
Set myFolder = Nothing
End Sub

Public Function GetFolder(strFolderPath)
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function

 

[Sue Mosher [MVP-Outlook]]

Pseudo code:

1) Get the folder from Favorites using GetFolder()
2a) If you get the folder, check its ShowAsOutlookAB property and set it as needed.
2b) If you don't get the folder, add it to Favorites and set ShowAsOutlookAB.

FYI, there is a newsgroup specifically for general Outlook programming issues "down the hall" at microsoft.public.outlook.program_vba or, via web interface, at http://www.microsoft.com/office/community/en-us/default.mspx?dg=microsoft.public.outlook.program_vba



--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers