Search code examples
vbaoutlookenumerationshared-directory

Outlook VBA work with public store folder


I am trying to add events to an outlook calendar in a public store (e.g. a PF store which doesn't belong to any particular user)

How to I reference that folder (calendar) to be able to work with items in it?

Enumerating by path (and the code below) takes about two minutes to work it's way down the folder I want, and then I cannot set a reference to it in the original sub routine.

Enumeration adapted from MSDN here.

Public Function EnumerateFoldersInStores(ByVal searchFolder As String) As Outlook.Folder
    Dim colStores As Outlook.Stores
    Dim oStore As Outlook.Store
    Dim oRoot As Outlook.Folder

    On Error Resume Next
    Set EnumerateFoldersInStores = Nothing
    Set colStores = Application.Session.Stores

    For Each oStore In colStores
        Set oRoot = oStore.GetRootFolder

        If oRoot.Name = searchFolder Then
            Debug.Print (oRoot.FolderPath)
            Set EnumerateFoldersInStores = EnumerateFolders(oRoot)
        End If
    Next
End Function

Private Function EnumerateFolders(ByVal oFolder As Outlook.Folder) As Outlook.Folder
    Dim folders As Outlook.folders
    Dim Folder As Outlook.Folder
    Dim foldercount As Integer

    On Error Resume Next

    Set folders = oFolder.folders
    foldercount = folders.Count

    'Check if there are any folders below oFolder
    If foldercount Then
        For Each Folder In folders
            Select Case Folder.Name
            Case "All Public Folders"
                Debug.Print (Folder.FolderPath)
                EnumerateFolders Folder
            Case "Sub-Location"
                Debug.Print (Folder.FolderPath)
                EnumerateFolders Folder
            Case "Department"
                Debug.Print (Folder.FolderPath)
                EnumerateFolders Folder
            Case "Division"
                Debug.Print (Folder.FolderPath)
                EnumerateFolders Folder
            Case "Work-Group"
                Debug.Print (Folder.FolderPath)
                EnumerateFolders Folder
            Case "Planning-Calendar"
                ' This is the folder I want to work with
                Debug.Print (Folder.FolderPath)
                Stop
                Set EnumerateFolders = Folder
            End Select
        Next
    End If
End Function

The full path is:\\Public Folders - [email protected]\All Public Folders\Sub-Location\Department\Division\Work-Group\Planning-Calendar


Solution

  • To reference a public folder: \Public Folders - [email protected]\All Public Folders\Sub-Location\Department\Division\Work-Group\Planning-Calendar

    Set PbFldr = GetNamespace("MAPI").GetDefaultFolder(olPublicFoldersAllPublicFolders)
    Set PbFldr = PbFldr.Folders("Sub-Location")
    Set PbFldr = PbFldr.Folders("Department")
    Set PbFldr = PbFldr.Folders("Division")
    Set PbFldr = PbFldr.Folders("Work-Group")
    Set PbFldr = PbFldr.Folders("Planning-Calendar")