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: 71
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
  • MS Outlook 2016 - Sadu složek nelze otevřít
    od KondomTom » 21 úno 2018 05:44 » v Komunikace na internetu
    1
    581
    od zeus
    21 úno 2018 06:58
  • svislé barevné pruhy (Vertical Lines of Death)
    od kaomanaka » 01 lis 2017 22:55 » v BSOD (Blue Screen Of Death)
    10
    687
    od kaomanaka
    12 lis 2017 13:05
  • Makro Excel - barevné zvýraznění výpisu z makra
    od Rosta_Kolmix » 22 lis 2017 13:42 » v Kancelářské balíky
    6
    406
    od Rosta_Kolmix
    24 lis 2017 21:15
  • Problém s mazáním složek
    od Kasparekaspi » 08 lis 2017 17:11 » v Vše ostatní (sw)
    19
    671
    od X
    14 lis 2017 04:08
  • Práva složek a podsložek
    od locika » 10 úno 2018 12:44 » v Windows 10, 8, 7, Vista, XP…
    5
    292
    od ITCrowd
    11 úno 2018 09:45

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

Kdo je online

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