有没有办法使用 Outlook 对象模型设置 Outlook 文件夹或子文件夹的自定义图标?
2 回答
从 Outlook 2010 开始,您可以MAPIFolder.SetCUstomIcon
如上所述使用。
我最近遇到了同样的挑战,并在 Change Outlook 文件夹颜色可能找到了一段很好的 VBA 代码片段?:
- 将文件icons.zip解压缩到 C:\icons
- 将下面的代码定义为 Visual Basic 宏
根据您的需要调整功能 ColorizeOutlookFolders 文本
Function GetFolder(ByVal FolderPath As String) As Outlook.folder ' Returns an Outlook folder object basing on the folder path ' Dim TempFolder As Outlook.folder Dim FoldersArray As Variant Dim i As Integer On Error GoTo GetFolder_Error 'Remove Leading slashes in the folder path If Left(FolderPath, 2) = "\\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 2) End If 'Convert folderpath to array FoldersArray = Split(FolderPath, "\") Set TempFolder = Application.Session.Folders.Item(FoldersArray(0)) If Not TempFolder Is Nothing Then For i = 1 To UBound(FoldersArray, 1) Dim SubFolders As Outlook.Folders Set SubFolders = TempFolder.Folders Set TempFolder = SubFolders.Item(FoldersArray(i)) If TempFolder Is Nothing Then Set GetFolder = Nothing End If Next End If 'Return the TempFolder Set GetFolder = TempFolder Exit Function GetFolder_Error: Set GetFolder = Nothing Exit Function End Function Sub ColorizeOneFolder(FolderPath As String, FolderColour As String) Dim myPic As IPictureDisp Dim folder As Outlook.folder Set folder = GetFolder(FolderPath) Set myPic = LoadPicture("C:\icons\" + FolderColour + ".ico") If Not (folder Is Nothing) Then ' set a custom icon to the folder folder.SetCustomIcon myPic 'Debug.Print "setting colour to " + FolderPath + " as " + FolderColour End If End Sub Sub ColorizeFolderAndSubFolders(strFolderPath As String, strFolderColour As String) ' this procedure colorizes the foler given by strFolderPath and all subfolfers Dim olProjectRootFolder As Outlook.folder Set olProjectRootFolder = GetFolder(strFolderPath) Dim i As Long Dim olNewFolder As Outlook.MAPIFolder Dim olTempFolder As Outlook.MAPIFolder Dim strTempFolderPath As String ' colorize folder Call ColorizeOneFolder(strFolderPath, strFolderColour) ' Loop through the items in the current folder. For i = olProjectRootFolder.Folders.Count To 1 Step -1 Set olTempFolder = olProjectRootFolder.Folders(i) strTempFolderPath = olTempFolder.FolderPath 'prints the folder path and name in the VB Editor's Immediate window 'Debug.Print sTempFolderPath ' colorize folder Call ColorizeOneFolder(strTempFolderPath, strFolderColour) Next For Each olNewFolder In olProjectRootFolder.Folders ' recursive call 'Debug.Print olNewFolder.FolderPath Call ColorizeFolderAndSubFolders(olNewFolder.FolderPath, strFolderColour) Next End Sub Sub ColorizeOutlookFolders() Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\100-People", "blue") Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\200-Projects","red") Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\500-Meeting", "green") Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\800-Product", "magenta") Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\600-Departments", "grey") Call ColorizeFolderAndSubFolders("\\Mailbox - Dan Wilson\Inbox\Customers", "grey") End Sub
在对象 ThisOutlookSession 中,定义以下函数:
Private Sub Application_Startup() ColorizeOutlookFolders End Sub
和
为了不对子文件夹着色,您可以使用函数 ColorizeOneFolder 而不是 ColorizeFolderAndSubFolders 例如
Sub ColorizeOutlookFolders() Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\100-People", "blue") Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\200-Projects", "red") Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\500-Meeting", "green") Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\800-Product", "magenta") Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\600-Departments", "grey") Call ColorizeOneFolder ("\\Mailbox - Dan Wilson\Inbox\Customers", "grey") End Sub
在文件夹之间移动子文件夹时,它们应仅保留其颜色,直到您下次重新启动 Outlook。
根据我的阅读,不幸的是,这在 Outlook 2007 中是不可能的。
在 Outlook 2010 中可以使用MAPIFolder.SetCustomIcon
. 有关详细信息,请参阅 MSDN:http: //msdn.microsoft.com/en-us/library/ff184775.aspx
在以下 MSDN 网页上切换 2010 和 2007 之间的 MAPIFolder 方法列表SetCustomIcon
仅显示 2010 的方法:http: //msdn.microsoft.com/en-us/library/bb645002.aspx