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")
我正在尝试将事件添加到 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")