Attribute VB_Name = "OL_Nachverfolgung"
Option Explicit

'© 2004 c't, Ralf Nebelo

Public Const APPNAME As String = "Outlook-Nachverfolgung"

'*****************************************************************
'Makros
'*****************************************************************

Public Sub OLNV_StartButtonsAnlegen()
    Dim strCBName As String
    Dim objCB As CommandBar
    Dim strButtonCaption As String
    Dim objButton As CommandBarButton
    Dim intPos As Integer
    
    'Fehlerverfolgung ausschalten
    On Error Resume Next
    
    'Name der Befehlsleiste
    strCBName = "Makros"
    'Verweis auf Befehlsleiste holen
    Set objCB = ActiveExplorer.CommandBars(strCBName)
    'Wenn Befehlsleiste nicht existiert, dann...
    If objCB Is Nothing Then
        '... Befehlsleiste anlegen
        Set objCB = ActiveExplorer.CommandBars.Add(strCBName, msoBarTop)
    End If
    
    'Button-Beschriftung angeben
    strButtonCaption = "Element(e) nachverfolgen"
    'Verweis auf Button holen
    Set objButton = objCB.FindControl(Tag:=strButtonCaption)
    'Wenn Button nicht existiert, dann...
    If objButton Is Nothing Then
        '... Button neu anlegen
        Set objButton = objCB.Controls.Add(Type:=msoControlButton)
        'Button konfigurieren
        With objButton
            'Tag-Wert zur Identifikation setzen
            .Tag = strButtonCaption
            'Nur Beschriftung
            .Style = msoButtonCaption
            'Gruppierung beginnen
            .BeginGroup = True
            'Beschriftung festlegen
            .Caption = strButtonCaption
            'Tooltip-Text festlegen
            .TooltipText = "Markierte Elemente zur Nachverfolgung kennzeichnen"
            'Mit Makro verknüpfen
            .OnAction = "OLNV_ElementeKennzeichnen"
        End With
    End If
    
    'Button-Beschriftung angeben
    strButtonCaption = "Zur Nachverfolgung"
    'Verweis auf Button holen
    Set objButton = objCB.FindControl(Tag:=strButtonCaption)
    'Wenn Button existiert, dann...
    If Not objButton Is Nothing Then
        '... dessen Position innerhalb der Befehlsleiste merken
        intPos = objButton.Index
        'Button löschen (notwendig zur Aktualisierung der Beschriftung)
        objButton.Delete
        'Neuen Button an Position des gelöschten anlegen
        Set objButton = objCB.Controls.Add(Type:=msoControlButton, Before:=intPos)
    'Wenn Button nicht existiert, dann...
    Else
        '... neuen Button am Ende der Befehlsleiste anlegen
        Set objButton = objCB.Controls.Add(msoControlButton)
    End If
    'Button konfigurieren
    With objButton
        'Tag-Wert zur Identifikation setzen
        .Tag = strButtonCaption
        'Nur Beschriftung
        .Style = msoButtonCaption
        'Keine Gruppierung beginnen
        .BeginGroup = False
        'Beschriftung festlegen (in Klammern Anzahl der Elemente)
        .Caption = strButtonCaption & " (" & CStr(HolElementAnzahl) & ")"
        'Tooltip-Text festlegen
        .TooltipText = "Zur Nachverfolgung gekennzeichnete Elemente anzeigen"
        'Mit Makro verknüpfen
        .OnAction = "OLNV_ElementeAnzeigen"
    End With
    
    'Befehlsleiste sichtbar machen
    objCB.Visible = True
End Sub

Public Sub OLNV_ElementeKennzeichnen()
    Dim objItem As Object
    
    'Alle markierten Elemente durchlaufen
    For Each objItem In ActiveExplorer.Selection
        'Eindeutige Entry-ID in Registry speichern
        SaveSetting APPNAME, "Elemente", objItem.EntryID, Format(Date, "Short Date")
    Next
    
    'Prozedur OLNV_StartButtonsAnlegen aufrufen, um die aktuelle Elementzahl
    'in der Beschriftung des zweiten Makrostart-Buttons anzuzeigen
    Call OLNV_StartButtonsAnlegen
End Sub

Public Sub OLNV_ElementeAnzeigen()
    'Userform frmNachverfolgung nicht modal aufrufen, da sonst aus Dialogfeld
    'heraus kein Öffnen von Outlook-Elementen möglich ist
    frmNachverfolgung.Show False
End Sub

'*****************************************************************
'Allgemeine Prozeduren
'*****************************************************************

Private Function HolElementAnzahl()
    Dim vntWerte As Variant
    Dim intAnzahl As Integer
    
    'Fehlerverfolgung ausschalten
    On Error Resume Next
    
    'Alle in Registry gespeicherte Werte lesen
    vntWerte = GetAllSettings(APPNAME, "Elemente")
    'Anzahl der Werte ermitteln
    intAnzahl = UBound(vntWerte, 1) + 1
    
    'Ergebnis zurückgeben
    HolElementAnzahl = intAnzahl
End Function
