Mehrere E-Mails in Termine im Kalender umwandeln

Sub CreateAppointmentsFromSelectedMails()
    Dim itm As Object, folderDestination As folder
    With ActiveExplorer
        ' if there is at least 1 selected mail ...  
        If .Selection.Count > 0 Then
            ' ask user to select the destination folder  
            Set folderDestination = Application.Session.PickFolder
            ' if not folder was choosen exit sub  
            If folderDestination Is Nothing Then Exit Sub
            ' check folder type of type to be a calendar folder  
            While folderDestination.DefaultItemType <> olAppointmentItem
                MsgBox "Bitte einen Ordner vom Typ Kalender wählen!", vbExclamation  
                Set folderDestination = Application.Session.PickFolder
                If folderDestination Is Nothing Then Exit Sub
            Wend
            ' for each item in selection  
            For Each itm In .Selection
                ' only process items of type "e-mail"  
                If itm.Class = olMail Then
                    ' create new appointment with details of mailitem  
                    With Application.CreateItem(olAppointmentItem)
                        ' assign subject  
                        .subject = itm.subject
                        ' assign body  
                        .Body = itm.Body
                        ' set start time to received time of mail  
                        .Start = itm.ReceivedTime
                        ' set end time of appointment to recivedtime + 5 minutes  
                        .End = DateAdd("n", 5, itm.ReceivedTime)  
                        ' do not set a reminder  
                        .ReminderSet = False
                        ' save appointment item in destination folder  
                        .Move folderDestination
                    End With
                End If
            Next
        Else
            ' user selected no mails  
            MsgBox "Bitte mindestens eine E-Mail auswählen!", vbExclamation  
        End If
    End With
End Sub