49 lines
1.2 KiB
OpenEdge ABL
49 lines
1.2 KiB
OpenEdge ABL
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
|
|
|