LastModificationTime in DB stimmt nicht mit Outlook überein

[Andreas Irmer]

Hallo zusammen,

in meiner Datenbank schreibe ich Termin in Outlook. Nach dem Schreibvorgang lese ich dann die LastModificationTime aus dem Outlook Element aus und speichere es in meiner Tabelle ab.

Ich mache das, damit ich bei einem neuen Durchlauf zum Speichern aller Termine nur die geänderten Termine bearbeite.

Aber:
Die Uhrzeit in meiner Tabelle weicht immer von der Uhrzeit im Outlooktermin ab. Ich hab hier mal einen debug.print ausgeführt, der erst den Termin der Tabelle und dann den Termin aus Outlook wieder gibt:
15.01.2023 21:59:46 15.01.2023 22:00:06
15.01.2023 21:59:46 15.01.2023 22:00:05
15.01.2023 21:59:46 15.01.2023 22:00:05
15.01.2023 21:59:46 15.01.2023 22:00:06
15.01.2023 21:59:46 15.01.2023 22:00:09
15.01.2023 21:59:47 15.01.2023 22:00:07
15.01.2023 21:59:47 15.01.2023 22:00:09
15.01.2023 21:59:47 15.01.2023 22:00:04
15.01.2023 21:59:47 15.01.2023 22:00:08
15.01.2023 21:59:47 15.01.2023 22:00:08
15.01.2023 21:59:47 15.01.2023 22:00:07
15.01.2023 21:59:47 15.01.2023 22:00:04
15.01.2023 21:59:47 15.01.2023 22:00:05
15.01.2023 21:59:48 15.01.2023 22:00:06
15.01.2023 21:59:48 15.01.2023 21:59:55
15.01.2023 21:59:48 15.01.2023 21:59:55
15.01.2023 21:59:48 15.01.2023 21:59:52
15.01.2023 21:59:48 15.01.2023 21:59:56
15.01.2023 21:59:48 15.01.2023 21:59:53
15.01.2023 21:59:48 15.01.2023 21:59:57
15.01.2023 21:59:49 15.01.2023 21:59:54
15.01.2023 21:59:49 15.01.2023 21:59:57
15.01.2023 21:59:49 15.01.2023 21:59:54
15.01.2023 21:59:49 15.01.2023 21:59:55
15.01.2023 21:59:49 15.01.2023 21:59:58
15.01.2023 21:59:49 15.01.2023 21:59:58
15.01.2023 21:59:49 15.01.2023 21:59:55
15.01.2023 21:59:49 15.01.2023 21:59:59
15.01.2023 21:59:50 15.01.2023 22:00:00
15.01.2023 21:59:50 15.01.2023 21:59:55
15.01.2023 21:59:50 15.01.2023 21:59:56
15.01.2023 21:59:50 15.01.2023 22:00:00
15.01.2023 21:59:50 15.01.2023 22:00:01
15.01.2023 21:59:50 15.01.2023 21:59:56
15.01.2023 21:59:50 15.01.2023 21:59:59
15.01.2023 21:59:51 15.01.2023 21:59:59
15.01.2023 21:59:51 15.01.2023 22:00:00
15.01.2023 21:59:51 15.01.2023 22:00:01
15.01.2023 21:59:51 15.01.2023 22:00:02
15.01.2023 21:59:51 15.01.2023 22:00:01
15.01.2023 21:59:51 15.01.2023 22:00:04
15.01.2023 21:59:52 15.01.2023 22:00:03
15.01.2023 21:59:52 15.01.2023 22:00:03
15.01.2023 21:59:52 15.01.2023 22:00:02
15.01.2023 21:59:52 15.01.2023 22:00:03
15.01.2023 21:59:52 15.01.2023 22:00:03
15.01.2023 21:59:52 15.01.2023 22:00:10
15.01.2023 21:59:53 15.01.2023 22:00:17
15.01.2023 21:59:53 15.01.2023 22:00:16
15.01.2023 21:59:53 15.01.2023 22:00:15

Man sieht also, dass es immer einen Unterschied gibt.

Wie kann ich das vermeiden?

Hier mein Code zum Export der Termine:

Code [Auswählen] Erweitern

Public Sub AlleTermineAktualisieren()
    Dim objOutlook As Outlook.Application
    Dim objMAPI As Outlook.NameSpace
    Dim objFolder As Outlook.Folder
    Dim objAppointmentItem As Outlook.AppointmentItem
    Dim objRecipient As Outlook.Recipient
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim Tab_Termine As DAO.Recordset
    Dim Zeile(6) As String
    Dim i As Integer
               
    On Error Resume Next
        Set objOutlook = GetObject(, "Outlook.Application")
        If Err.Number = 429 Then
            Err.Clear
            Set objOutlook = CreateObject("Outlook.Application")
            If Err.Number = 429 Then
                MsgBox "Outlook ist nicht installiert."
            End If
        End If
    Set objMAPI = objOutlook.GetNamespace("MAPI")
    Set db = CurrentDb
    Set rst = db.OpenRecordset("SELECT Termine.*, Auftraege.AdrNr_ID_F, Auftraege.AB_Nr, Auftraege.Auftragsbeschreibung, Auftraege.uebernachtung, Auftraege.warten, Auftraege.Notiz, Auftraege.muss_stehen_bleiben, Kunden_DB.*, Mitarbeiter.Vorname, Taetigkeiten.Taetigkeit FROM Taetigkeiten INNER JOIN (Mitarbeiter INNER JOIN (Kunden_DB INNER JOIN (Auftraege INNER JOIN Termine ON (Auftraege.Auftraege_ID = Termine.Auftraege_ID_F) AND (Auftraege.Auftraege_ID = Termine.Auftraege_ID_F)) ON Kunden_DB.AdrNr = Auftraege.AdrNr_ID_F) ON Mitarbeiter.Mitarbeiter_ID = Termine.Mitarbeiter_ID_F) ON Taetigkeiten.Taetigkeit_ID = Termine.Taetigkeit_ID_F", dbOpenDynaset)
    Set Tab_Termine = db.OpenRecordset("Termine", dbOpenDynaset)
    Do While Not rst.EOF
        Set objRecipient = Nothing
        For i = 1 To 6
            Zeile(i) = ""
        Next
        Select Case rst!Vorname
            Case "Robert"
                Set objRecipient = objMAPI.CreateRecipient("Info")
            Case "Michael"
                Set objRecipient = objMAPI.CreateRecipient("Info")
            Case "Dominik"
                Set objRecipient = objMAPI.CreateRecipient("Dominik Sievers")
            Case "Andreas"
                Set objRecipient = objMAPI.CreateRecipient("Andreas Irmer")
        End Select
        Set objFolder = objMAPI.GetSharedDefaultFolder(objRecipient, olFolderCalendar)
        If IsNull(rst!OL_TerminID) Then
           
            Set objAppointmentItem = objFolder.Items.Add(olAppointmentItem)
            With objAppointmentItem
                .Subject = rst!Taetigkeit & ", " & rst!AdrNr_ID_F & ", " & rst!Re_Na2 & ", " & rst!AB_Nr & ", " & rst!Re_Tel & ", " & rst!Re_EMail1
                .Start = rst!Termin_Datum & " " & rst!Termin_Beginn
                .End = rst!Termin_Datum & " " & rst!Termin_Ende
                Zeile(1) = "Mitarbeiter: " & rst!Vorname & vbCr
                Zeile(2) = "Auftragsbeschreibung: " & rst!Auftragsbeschreibung & vbCr & vbCr
                Zeile(3) = "besondere Notizen zum Auftrag: " & rst!Notiz & vbCr & vbCr
                If rst!warten = True Then
                    Zeile(4) = "Kd. wartet auf Fertigstellung!" & vbCr
                Else
                    Zeile(4) = "Kd. wartet nicht auf Fertigstellung!" & vbCr
                End If
                If rst!uebernachtung = True Then
                    Zeile(5) = "Kd. übernachtet im Fz.!" & vbCr
                Else
                    Zeile(5) = vbCr
                End If
                If rst!muss_stehen_bleiben = True Then
                    Zeile(6) = "Fz. muss eine Nacht stehen bleiben!"
                Else
                    Zeile(6) = ""
                End If
                .Body = Zeile(1) & Zeile(2) & Zeile(3) & Zeile(4) & Zeile(5) & Zeile(6)
                .AllDayEvent = rst!Ganztag
                .Categories = rst!Taetigkeit
                .Save
            End With
            Tab_Termine.FindFirst "Termine_ID =" & rst!Termine_ID
            Tab_Termine.Edit
                Tab_Termine!OL_TerminID = objAppointmentItem.EntryID                'EntryID und
                Tab_Termine!GeaendertAm = objAppointmentItem.LastModificationTime   'LastModificationDate schreiben
            Tab_Termine.Update
               
        Else
            Set objAppointmentItem = objMAPI.GetItemFromID(rst!OL_TerminID)
            If rst!GeandertAm <> objAppointmentItem.LastModificationTime Then
                Debug.Print rst!GeaendertAm & " " & objAppointmentItem.LastModificationTime
               
                With objAppointmentItem
                    .Subject = rst!Taetigkeit & ", " & rst!AdrNr_ID_F & ", " & rst!Re_Na2 & ", " & rst!AB_Nr & ", " & rst!Re_Tel & ", " & rst!Re_EMail1
                    .Start = rst!Termin_Datum & " " & rst!Termin_Beginn
                    .End = rst!Termin_Datum & " " & rst!Termin_Ende
                    Zeile(1) = "Mitarbeiter: " & rst!Vorname & vbCr
                    Zeile(2) = rst!Auftragsbeschreibung & vbCr & vbCr
                    Zeile(3) = rst!Notiz & vbCr & vbCr
                    If rst!warten = True Then
                        Zeile(4) = "Kd. wartet auf Fertigstellung!" & vbCr
                    Else
                        Zeile(4) = "Kd. wartet nicht!" & vbCr
                    End If
                    If rst!uebernachtung = True Then
                        Zeile(5) = "Kd. übernachtet im Fz.!" & vbCr
                    Else
                        Zeile(5) = vbCr
                    End If
                    If rst!muss_stehen_bleiben = True Then
                        Zeile(6) = "Fz. muss eine Nacht stehen bleiben!"
                    Else
                        Zeile(6) = ""
                    End If
                    .Body = Zeile(1) & Zeile(2) & Zeile(3) & Zeile(4) & Zeile(5) & Zeile(6)
                    .AllDayEvent = rst!Ganztag
                    .Categories = rst!Taetigkeit
                    .Save
                End With
                Tab_Termine.FindFirst "Termine_ID =" & rst!Termine_ID
           
                Tab_Termine.Edit
                    Tab_Termine!GeaendertAm = objAppointmentItem.LastModificationTime   'LastModificationDate schreiben
                Tab_Termine.Update
            End If
        End If
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Set Tab_Termine = Nothing
    Set objRecipient = Nothing
    MsgBox ("Ausgabe erolgt")
End Sub

Bei den inzwischen ca 80 Terminzeilen dauert der Export dadurch schon knapp 10 Sekunden. wir werden zukünftig aber schnell über mehrere hundert Zeilen sprechen.

Danke für euer Feedback.