Hallo zusammen.

Ich habe einen Projektplan und bestimmte Zellen mit Datum werden aktuell in mein OUtlook Kalender übertragen. Allerdings setzt der Termin auf 00:05 Uhr. Ich hätte ihn gerne ganztägig und finde dazu leider keine Lösung. Ich bitte um Hilfe bei ERgänzung des Codes:

Sub Projektannahme_Klicken()

Dim OutApp As Object, ApptOutApp As Object
ActiveSheet.Range("J22").Select

Set OutApp = CreateObject("Outlook.Application")
Set ApptOutApp = OutApp.CreateItem(1) 'olAppointmentItem
With ApptOutApp
         .Start = Format(ActiveCell.Value, "dd.mm.yyyy") '& "08.00"

         .Subject = "Projektplan " & ActiveSheet.Range("D4 ") & ActiveSheet.Range("B22 ") 'ActiveCell.Offset(0, -7)
         .Body = ActiveSheet.Name
    .Location = "Büro"
    .Duration = "5"
    .ReminderMinutesBeforeStart = 10
    .ReminderPlaySound = True
    .ReminderSet = True
    .Save
End With

MsgBox "Termine übertragen"
End Sub

Danke!