[newone88]

Hi,
I'm trying to get this cript to work to with Exchange 2010 server but it is not working for some reason. We have 20 distribution lists in our public folders. We have to right click on each and enabale "Show this folder as an email address book" for each user.
Looks like this script might do the job but it is not running correctly.
It fails on GetObject line
Can someone help?

Dim aFolders, fldr, i, j, objNS, FolderPath
rootFolder = "Public Folders\All Public Folders\EMAIL DISTRIBUTION LISTS"
Set objNS = GetObject("", "Outlook.Application").GetNamespace("MAPI")
aFolders = Split(rootFolder, "\")
On Error Resume Next
Set fldr = objNS.Folders(aFolders(0))
If Err Then WScript.Quit
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
If Err Then WScript.Quit
Next
On Error Goto 0
'here 'fldr' contains your starting 'rootFolder' object, now enum all subfolders in there:
EnumSubFolders fldr 'call recursive function for this folder
Set objNS = Nothing
Function EnumSubFolders(tempfolder)
'folder types: 0 = mail; 1 = calendar; 2 = contacts; 3 = tasks; 4 = journal; 5 = notes
If(tempFolder.DefaultItemType = 2) Then
tempFolder.ShowAsOutlookAB = True 'mark current folder as mail address book
End If
If tempfolder.Folders.Count Then 'if there are several subfolders in here
For j = 1 To tempfolder.Folders.Count
EnumSubFolders tempfolder.Folders(j) 'call same function again for each subfolder
Next
End If
End Function