[Daggi Buh]

Hallo,

habe unter Outlook 2010 folgenden Code zusammengebastelt und der klappt auch sehr gut.
Nun möchte ich diesen Code aber so erweitern, dass die EMails, die ich in den Ordner IT Aufgaben verschoben habe (und die dadurch ganz wundervolle Aufgaben geworden sind), anschliessend direkt öffne, damit ich diese direkt noch überarbeiten kann.

Und da weiss ich jetzt nicht wie ich die jeweilige Aufgabe wiederfinden soll. Aber vielleicht hat hier jamand eine Idee

Hier schonmal mein Code:

Sub CopyAndMove()

On Error Resume Next

Dim objNS As Outlook.NameSpace
Dim objItem As Outlook.MailItem
Dim objNewMailItem As Outlook.MailItem

Dim objPF As MAPIFolder
Dim objAPF As MAPIFolder
Dim objMKF As MAPIFolder
Dim objUKF As MAPIFolder

'Öffentlichen Ordner IT Mails auswählen
Set objNS = Application.GetNamespace("MAPI")
Set objPF = objNS.Folders("Öffentliche Ordner - " & objNS.CurrentUser.Name)
Set objAPF = objPF.Folders("Alle Öffentlichen Ordner")
Set objUKF = objAPF.Folders("IT")
Set objMKF = objUKF.Folders("IT Mails")

' Wenn es den Ordner nicht gibt...
    If objMKF Is Nothing Then
        MsgBox "Dieser Ordner existiert nicht!", vbOKOnly + vbExclamation, "Fehler"
    End If
    
' Wenn nichts markiert ist...
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    End If
    
' Jede markierte Mail kopieren
    For Each objItem In Application.ActiveExplorer.Selection
        Set objNewMailItem = objItem.Copy
        objNewMailItem.Move objMKF
    Next

' 'Öffentlichen Ordner IT Aufgaben auswählen
Set objMKF = objUKF.Folders("IT Aufgaben")

' Wenn es den Ordner nicht gibt...
    If objMKF Is Nothing Then
        MsgBox "Dieser Ordner existiert nicht!", vbOKOnly + vbExclamation, "Fehler"
    End If
    
' Jede markierte Mail verschieben -> und gleichzeitig als Aufgabe umwandeln (macht Outlook alleine)
    For Each objItem In Application.ActiveExplorer.Selection
        objItem.UnRead = True
        objItem.Move objMKF
    Next

Set objItem = Nothing
Set objMKF = Nothing
Set objNS = Nothing
Set objPF = Nothing
Set objAPF = Nothing
Set objMKF = Nothing
Set objNewMailItem = Nothing

End Sub

Vielen lieben Dank,
Daggi