MS Outlook, barevné ikony složek

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

VOM
Level 1
Level 1
Příspěvky: 64
Registrován: srpen 10
Pohlaví: Muž

MS Outlook, barevné ikony složek

Příspěvekod VOM » 20 zář 2017 13:21

Pěkně zdravím
Pro označování složek MS Outlooku 2010 barevnými ikonami (uloženy v c:\icons\) používám níže uvedené makra (už si nepamatuji kde jsem je našel).
Prosím o radu jak upravit, abych nemusel zadával celý název složky, ale např. aby všechny složky do Maďarska (označené HUN, viz poslední makro) byly modré.
díky
Milan



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 ColorizeFolderAndSubFolders(strFolderPath As String, strFolderColour As String)
' this procedure colorizes the folder 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("\\Ing. Milan \_LIVE", "red")
Call ColorizeFolderAndSubFolders("\\Ing. Milan \_LIVE\14501_CZE_PROV_KTMU1800", "magenta")
Call ColorizeFolderAndSubFolders("\\Ing. Milan \_LIVE\16149_HUN_Nitro_KTM1800", "blue")
Call ColorizeFolderAndSubFolders("\\Ing. Milan \_LIVE\17176_HUN_CHC2700", "blue")




End Sub



Reklama
  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Barevné sladění dvou videonahrávek
    od agnus » 01 dub 2017 11:03 » v Design a grafické editory
    0
    202
    od agnus
    01 dub 2017 11:03
  • Makro Excel - barevné zvýraznění výpisu z makra
    od Rosta_Kolmix » 22 lis 2017 13:42 » v Kancelářské balíky
    6
    219
    od Rosta_Kolmix
    24 lis 2017 21:15
  • svislé barevné pruhy (Vertical Lines of Death)
    od kaomanaka » 01 lis 2017 22:55 » v BSOD (Blue Screen Of Death)
    10
    415
    od kaomanaka
    12 lis 2017 13:05
  • Problém s mazáním složek
    od Kasparekaspi » 08 lis 2017 17:11 » v Vše ostatní (sw)
    19
    512
    od X
    14 lis 2017 04:08
  • Nastavení práva složek a podsložek
    od DenyKr » 07 pro 2017 16:14 » v Windows 10, 8, 7, Vista, XP…
    7
    191
    od DenyKr
    08 pro 2017 08:50

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 1 host