Option Explicit

'Klassenmodul DieseOutlookSitzung
' 2001, Ralf Nebelo

Const SYM_NAME = "Sprachausgabe"

Private Sub Application_Startup()
    Dim objCB As CommandBar
    
    On Error Resume Next

    'Symbolleiste lschen
    ActiveExplorer.CommandBars(SYM_NAME).Delete
    'Symbolleiste neu anlegen
    Set objCB = ActiveExplorer.CommandBars.Add(Name:=SYM_NAME)
    With objCB
        'Symbolleiste mit Makrostart-Schaltflchen bestcken
        Call ButtonAnlegen(SYM_NAME, "Markierte Elemente", 182, "MarkierteElementeVorlesen", False)
        Call ButtonAnlegen(SYM_NAME, "Ungelesene Nachrichten", 262, "UngeleseneNachrichtenVorlesen", True)
        Call ButtonAnlegen(SYM_NAME, "Fllige Aufgaben", 161, "FlligeAufgabenVorlesen", False)
        Call ButtonAnlegen(SYM_NAME, "Fllige Termine", 33, "FlligeTermineVorlesen", False)
        Call ButtonAnlegen(SYM_NAME, "Optionen", 548, "OptionenFestlegen", True)
        
        'Symbolleiste am unteren Rand andocken und sichtbar machen
        .Position = msoBarBottom
        .Visible = True
    End With
    
    'Wenn DatumVorlesen-Option gesetzt, dann...
    If CBool(GetSetting(APPNAME:="VBAMakros", Section:="OL_Vorlesen", Key:="DatumVorlesen", Default:="Wahr")) = True Then
        '... Datum vorlesen
        With frmVorlesen
            .Caption = "Tagesdatum"
            .wspMund.SetText "Es ist " & WeekdayName(Weekday(Date, vbMonday)) & " der " & Format(Date, "dd. mmmm yyyy") & "."
            .Show
        End With
    End If
    
    'Wenn FlligeAufgabenVorlesen-Option gesetzt, dann...
    If CBool(GetSetting(APPNAME:="VBAMakros", Section:="OL_Vorlesen", Key:="FlligeAufgabenVorlesen", Default:="Falsch")) = True Then
        '... Makro FlligeAufgabenVorlesen aufrufen
        Call FlligeAufgabenVorlesen
    End If
    
    'Wenn FlligeTermineVorlesen-Option gesetzt, dann...
    If CBool(GetSetting(APPNAME:="VBAMakros", Section:="OL_Vorlesen", Key:="FlligeTermineVorlesen", Default:="Falsch")) = True Then
        '... Makro FlligeTermineVorlesen aufrufen
        Call FlligeTermineVorlesen
    End If
End Sub

Private Sub Application_NewMail()
    Dim objNameSpace As NameSpace
    Dim objPosteingang As MAPIFolder
    Dim objNachricht As MailItem
    Dim strText As String
    Dim strDatList As String
    Dim objAnhang As Attachment
    Dim intDotPos As Integer
    Dim strEndung As String
    
    On Error Resume Next

    Set objNameSpace = GetNamespace("MAPI")
    Set objPosteingang = objNameSpace.GetDefaultFolder(olFolderInbox)

    'Alle Nachrichten durchlaufen
    For Each objNachricht In objPosteingang.Items
        'Wenn Nachricht ungelesen und nicht als 'gemeldet' gekennzeichnt ist, dann...
        If objNachricht.UnRead = True And objNachricht.UserProperties.Find("Gemeldet") Is Nothing Then
            '... Absender vorlesen
            strText = "Sie haben eine neue Nachricht von " & objNachricht.SenderName & "."
            
            'Wenn Option AnhangMelden gesetzt ist und Nachricht Anhnge besitzt, dann ...
            If CBool(GetSetting(APPNAME:="VBAMakros", Section:="OL_Vorlesen", Key:="AnhangMelden", Default:="Wahr")) = True And objNachricht.Attachments.Count > 0 Then
                '... Liste gefhrlicher Datei-Extensions definieren
                strDatList = ".vbs.js.exe.com.bat.doc.dot.xls.xlt.xla.ppt.ppa"
                'Alle Anhnge der Reihe nach durchlaufen
                For Each objAnhang In objNachricht.Attachments
                    'Nach Punkt im Dateinamen fahnden
                    intDotPos = InStr(objAnhang.FileName, ".")
                    'Wenn Punkt vorhanden, dann...
                    If intDotPos > 0 Then
                        '... Extension isolieren
                        strEndung = Right(objAnhang.FileName, Len(objAnhang.FileName) - intDotPos + 1)
                        'Wenn Extension in strDatList enthalten ist, dann...
                        If InStr(strDatList, LCase(strEndung)) > 0 Then
                            '... Warntext hinzufgen
                            strText = strText & "Achtung! Die Nachricht enthlt mglicherweise gefhrliche Anhnge!"
                            Exit For
                        End If
                    End If
                Next
            End If
            
            'Wenn Option VorschauAus gesetzt ist und Nachricht im HTML-Format vorliegt, dann ...
            If CBool(GetSetting(APPNAME:="VBAMakros", Section:="OL_Vorlesen", Key:="VorschauAus", Default:="Wahr")) = True And objNachricht.GetInspector.EditorType = olEditorHTML Then
                '... Warntext hinzufgen und...
                strText = strText & "Achtung! Die Nachricht liegt im HTML-Format vor!"
                '... Vorschaufenster schlieen
                ActiveExplorer.ShowPane olPreview, False
            End If
            
            'Vorlesen starten
            With frmVorlesen
                .Caption = "Neue Nachricht"
                .wspMund.SetText strText
                .Show
            End With
            
            'Nachricht als 'gemeldet' kennzeichnen
            objNachricht.UserProperties.Add("Gemeldet", olText).Value = "Ja"
            'Nachricht speichern
            objNachricht.Save
        End If
    Next
End Sub

Private Sub Application_Quit()
    On Error Resume Next
        
    'Symbolleiste lschen
    ActiveExplorer.CommandBars(SYM_NAME).Delete
End Sub
  
'*******************************************************************
'Hilfsroutinen
'*******************************************************************

Private Sub ButtonAnlegen(strSymName As String, strCaption As String, intFaceID As Integer, strMakro As String, blnGruppe As Boolean)
    Dim objCTL As CommandBarControl
            
    'Schaltflche anlegen
    Set objCTL = ActiveExplorer.CommandBars(strSymName).Controls.Add(Type:=msoControlButton)
    With objCTL
        .BeginGroup = blnGruppe
        'Beschriftung festlegen
        .Caption = strCaption
        'Grafisches Symbol festlegen
        .FaceId = intFaceID
        'Stil festlegen
        .Style = msoButtonIconAndCaption
        'Makro zuweisen
        .OnAction = strMakro
    End With
End Sub


