VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ThisOutlookSession"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Sub setCategories()

    frmSetCategories.Show
    
End Sub

Sub moveMessage()
    Dim objNS As Outlook.NameSpace
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As Variant
    Dim objCopy As Outlook.MailItem
    Dim destFolder() As String
        
    Set objNS = Application.GetNamespace("MAPI")
    
    Set objItem = Application.ActiveExplorer.Selection.Item(1)
   
    ' Zielordner festlegen - aus Einstellungen
    destFolder = Split(Replace(gfSettings.GetSettingValue("OnlineArchiv"), "'", ""), ",")
    destFolder = Split(Right(destFolder(0), Len(destFolder(0)) - 1), "\")
    Set objDestFolder = objNS.Folders(destFolder(0)).Folders(destFolder(1))
   
   ' vor dem Verschieben prüfen ob eine Kategorie vorhanden ist
    If Len(objItem.categories) = 0 Then
        MsgBox "Bitte Kategorie zuweisen"
        Exit Sub
    End If
    
    ' Objekt als gelesen markieren
    objItem.UnRead = False
    
    ' copy and move first
    objItem.Move objDestFolder

    Set objDestFolder = Nothing
    Set objNS = Nothing

End Sub