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:
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.