Dim olApp As Microsoft.Office.Interop.Outlook.Application
    Dim appItem As AppointmentItem
    Dim UrlOrdner As MAPIFolder
 
    olApp = CreateObject("Outlook.Application")
    appItem = olApp.CreateItem(OlItemType.olAppointmentItem)
    appItem.Subject = "Testeintrag"
    appItem.Start = "12.10.2011"
    appItem.End = "15.10.2011"
    appItem.AllDayEvent = True
 
    UrlOrdner = olApp.GetNamespace("MAPI") _
                .Folders.Item("Öffentliche Ordner") _
                .Folders.Item("Alle Öffentlichen Ordner") _
                .Folders.Item("<NAMEDERFIRMA") _
                .Folders.Item("Verkauf") _
                .Folders.Item("Urlaub Logistik")
 
    appItem.Move(UrlOrdner)
    appItem.Save()