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
|