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: 61
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
    194
    od agnus
    01 dub 2017 11:03
  • Porovnání obsahu dvou složek a doplnění
    od Strapal » 08 srp 2017 03:25 » v Windows 10, 8, 7, Vista, XP…
    7
    331
    od faraon
    20 srp 2017 20:58
  • Ikony ve Windows 8
    od Grymaz » 31 pro 2016 00:39 » v Windows 10, 8, 7, Vista, XP…
    0
    123
    od Grymaz
    31 pro 2016 00:39
  • Ikony na ploše
    od josef » 15 srp 2017 18:09 » v Windows 10, 8, 7, Vista, XP…
    2
    217
    od faraon
    16 srp 2017 09:43
  • Malé ikony v programech
    od Stene » 04 čer 2017 18:54 » v Vše ostatní (sw)
    3
    233
    od petr22
    04 čer 2017 19:15

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

Kdo je online

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