OL 2002 VBA Problem bei einem Pfad

Option Explicit
Dim MyOLApp As Application
Dim myNameSpace As NameSpace

Public WithEvents olItem As MailItem
Private Sub Application_Startup()
    
    Dim olItem As MailItem
    Dim oeff As Outlook.MAPIFolder
    Dim olApp As Outlook.Application
    Dim olTask As Outlook.TaskItem
    Dim cntSelection As Integer
    Dim I
    Dim sent As Outlook.Explorer
    Dim cf As Outlook.MAPIFolder
    
        Set olApp = New Outlook.Application
        Set oeff = olApp.GetNamespace("MAPI").Folders.Item("Öffentliche Ordner").Folders.Item("Alle Öffentlichen Ordner").Folders.Item("Firma Ordner").Folders.Item("Abteilung").Folders.Item("Abteilung Tasks")  
            
            If oeff Is Nothing Then
                MsgBox "Invalid Folder"  
                
            Else
            
Set olApp = Outlook.CreateObject("Outlook.Application")  
Set olTask = olApp.CreateItem(olTaskItem)
Set sent = olApp.ActiveExplorer
Set cf = sent.CurrentFolder

cntSelection = sent.Selection.Count
For I = 1 To cntSelection
Set olItem = sent.Items(I)
olTask.Attachments.Add olItem
olTask.Subject = "Empfangen zu Vorgang Betreff: " & olItem.Subject  
olTask.Body = olItem.Body
olItem.Move Application.GetNamespace("MAPI").Folders.Item("Öffentliche Ordner").Folders.Item("Alle Öffentlichen Ordner").Folders.Item("Firma Ordner").Folders.Item("Abteilung").Folders.Item("Abteilung Tasks")  

Next
olTask.DueDate = DateAdd("h", 48, Now)  
olTask.StartDate = DateAdd("h", 0, Now)  

olTask.ReminderSet = True
olTask.ReminderTime = DateAdd("h", 24, Now)  

olTask.Save
olTask.Move Application.GetNamespace("MAPI").Folders.Item("Öffentliche Ordner").Folders.Item("Alle Öffentlichen Ordner").Folders.Item("Firma Ordner").Folders.Item("Abteilung").Folders.Item("Abteilung Tasks")  
olTask.Display
        End If
End Sub