No announcement yet.

Script to select "Show this folder as an email address book"

  • Filter
  • Time
  • Show
Clear All
new posts

  • Script to select "Show this folder as an email address book"

    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
    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
    End If
    End Function