Outlook VBA 使用 public 存储文件夹

Outlook VBA work with public store folder

我正在尝试将事件添加到 public 商店(例如,不属于任何特定用户的 PF 商店)的 Outlook 日历中

如何引用该文件夹(日历)以便能够处理其中的项目?

按路径(和下面的代码)枚举大约需要两分钟才能找到我想要的文件夹,然后我无法在原始子例程中设置对它的引用。

枚举改编自 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

完整路径为:\Public Folders - currentuser@domain.com\All Public Folders\Sub-Location\Department\Division\Work-Group\Planning-Calendar

要引用 public 文件夹:\Public 文件夹 - currentuser@domain.com\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")