Hallo Leute, ich habe eine Frage zu dem Themengebiet VBA Code. Ich habe mir ein Code ergoogelt der ein Excel Datum als Outlook Termin einträgt, diesen Code musste ich anpassen und nun Funktioniert er nicht mehr richtig:

Problem: die Felder werden alle richtig in Outlook übertragen, nur das Datum wird IMMER auf den 30.12.1899 gesetzt und ich hab keine Ahnung warum

Hat von euch jemand eine Idee woran das liegen könnte?

Hier der Code:

Sub terminINoutlook()
'
' Beispiel-Funktion - Markieren - und autoamtisch eintragen in Outlook
' 2016, www.stallwanger.net

'Declaration der Variablen
   Dim StartDatum As Date
   Dim Pruefer As String
   'Dim Nachricht As String
   'Dim Ort As String
   Dim Beschreibung As String
   'Dim Dauer As Long
   
 'with: eine Reihe von Anweisungen für ein bestimmtes Objekt
   With Excel.Selection
    
    StartDatum = .Cells(4).Value 'Cells(1) weist die erste Spalte (mxn)
     Pruefer = .Cells(5).Value
     Beschreibung = .Cells(6).Value
     'Dauer = .Cells(7).Value
    'Nachricht = .Cells(4).Value
    'Ort = .Cells(5).Value
   
  End With
   
  'Nach Outlook
   
   lvOutlook StartDatum, Beschreibung, Pruefer
   
 
'
End Sub


Public Function lvOutlook(outDate As Date, outSubject As String, outBody As String) As Boolean 'boolean typ kann wahr oder falsch speichern
 
'Hier beginnen die Termine
    Set OutApp = CreateObject("Outlook.Application")
    Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
    With apptOutApp
        'Datum und Uhrzeit - als Start-Uhrzeit 8:00 -
        
        .Start = CDate(Cells(4).Value)
        
        'Start = Cells(4).Value
        '.Start = Format(Cells(4).Value, "dd.mm.yyyy") & " 09:00" ' Es kann auch eine andere Uhrzeit festgelegt werden.
         '.Start = Format(outDate, "dd.mm.yyy") & " 09:00" ' Es kann auch eine andere Uhrzeit festgelegt werden.
         
         '.Date = outDate
         
        'Termininfo
        .Subject = outSubject
        'oder der Betreff steht in der Spalte rechts von den Terminen
        
      '  .Location = outlocation '         'Ort
        
        .Body = outBody '
         
       '.Duration = outDauer   ' 1 Std. = "60" Dauer in Minuten
        'Erinnerung setzen in Outlook (hier inaktiv)
      '
        .ReminderPlaySound = True
         
        
       'Erinnerung wiederholen
        .ReminderSet = True
         
        'Termin speichern
        .Save
    End With
     
    Set apptOutApp = Nothing
    Set OutApp = Nothing
 
'Debug.Print
 
 
    lvOutlook = True
    MsgBox "Termin an Outlook übertragen."
      
Exit Function
 
ErrOutLook:
Set apptOutApp = Nothing
Set OutApp = Nothing
lvOutlook = False
MsgBox "Termin konnte in Outlook nicht eingetragen werden.  Fehler:" & Err.Description
 
End Function