lerone revised this gist . Go to revision
1 file changed, 7 insertions, 5 deletions
gistfile1.txt
| @@ -56,8 +56,9 @@ Sub SerienKalendereintraegeErstellen() | |||
| 56 | 56 | ||
| 57 | 57 | Dim gefilterteItems As Object | |
| 58 | 58 | Dim filterDatum As String | |
| 59 | - | filterDatum = Format(Now, "mm/dd/yyyy hh:nn AMPM") | |
| 59 | + | filterDatum = Format(Date, "mm/dd/yyyy 12:00 AM") | |
| 60 | 60 | Set gefilterteItems = olItems.Restrict("[Start] >= '" & filterDatum & "'") | |
| 61 | + | Debug.Print "Gefilterte Einträge: " & gefilterteItems.Count | |
| 61 | 62 | ||
| 62 | 63 | On Error Resume Next | |
| 63 | 64 | Set logSheet = ThisWorkbook.Sheets("Gelöschte Termine") | |
| @@ -217,15 +218,16 @@ Sub OutlookEintragErstellen(ByVal selectedCalendar As Object, ByVal gefilteteIte | |||
| 217 | 218 | If existingItem.Subject <> titel Then | |
| 218 | 219 | Dim msg As VbMsgBoxResult | |
| 219 | 220 | msg = MsgBox("Ein Kalendereintrag mit derselben Veranstaltungsnummer existiert, aber der Titel unterscheidet sich:" & vbCrLf & _ | |
| 220 | - | "Bestehender Titel: " & existingItem.Subject & vbCrLf & _ | |
| 221 | - | "Neuer Titel: " & titel & vbCrLf & vbCrLf & _ | |
| 222 | - | "Trotzdem neuen Eintrag erstellen?", vbYesNo + vbExclamation, "Unstimmigkeit bei Titel") | |
| 221 | + | "Bestehender Titel: " & existingItem.Subject & vbCrLf & _ | |
| 222 | + | "Neuer Titel: " & titel & vbCrLf & vbCrLf & _ | |
| 223 | + | "Trotzdem neuen Eintrag erstellen?", vbYesNo + vbExclamation, "Unstimmigkeit bei Titel") | |
| 223 | 224 | If msg = vbNo Then Exit Sub | |
| 224 | 225 | Else | |
| 226 | + | Debug.Print "Duplikat gefunden für Datum: " & datum & ", Titel: " & titel | |
| 225 | 227 | Exit Sub ' Duplikat mit gleichem Titel und Veranstaltungsnummer | |
| 226 | 228 | End If | |
| 227 | 229 | End If | |
| 228 | - | ' Duplikat erkannt | |
| 230 | + | Debug.Print "Übersprungen wegen vorhandenem Eintrag: " & datum & " - " & titel | |
| 229 | 231 | Exit Sub | |
| 230 | 232 | End If | |
| 231 | 233 | End If | |
lerone revised this gist . Go to revision
1 file changed, 14 insertions, 3 deletions
gistfile1.txt
| @@ -125,9 +125,20 @@ SkipJ: | |||
| 125 | 125 | ||
| 126 | 126 | If eintraege.Count = 1 Then | |
| 127 | 127 | Dim idx As Variant: idx = eintraege(1) | |
| 128 | - | startzeit = ws.Cells(idx, "C").Value | |
| 129 | - | endzeit = ws.Cells(idx, "D").Value | |
| 130 | - | datum = ws.Cells(idx, "B").Value | |
| 128 | + | If IsDate(ws.Cells(idx, "C").Value) Then | |
| 129 | + | startzeit = TimeValue(ws.Cells(idx, "C").Value) | |
| 130 | + | Else | |
| 131 | + | ws.Cells(idx, "M").Value = "übersprungen (ungültige Startzeit)" | |
| 132 | + | GoTo Weiter | |
| 133 | + | End If | |
| 134 | + | ||
| 135 | + | If IsDate(ws.Cells(idx, "D").Value) Then | |
| 136 | + | endzeit = TimeValue(ws.Cells(idx, "D").Value) | |
| 137 | + | Else | |
| 138 | + | ws.Cells(idx, "M").Value = "übersprungen (ungültige Endzeit)" | |
| 139 | + | GoTo Weiter | |
| 140 | + | End If | |
| 141 | + | datum = DateValue(ws.Cells(idx, "B").Value) | |
| 131 | 142 | If DRYRUN Then | |
| 132 | 143 | ws.Cells(idx, "M").Value = "[Simulation] Einzel: " & titel | |
| 133 | 144 | Else | |
lerone revised this gist . Go to revision
No changes
lerone revised this gist . Go to revision
1 file changed, 3 insertions, 1 deletion
gistfile1.txt
| @@ -55,7 +55,9 @@ Sub SerienKalendereintraegeErstellen() | |||
| 55 | 55 | olItems.IncludeRecurrences = True | |
| 56 | 56 | ||
| 57 | 57 | Dim gefilterteItems As Object | |
| 58 | - | Set gefilterteItems = olItems.Restrict("[Start] >= '" & Format(Date, "ddddd h:nn AMPM") & "'") | |
| 58 | + | Dim filterDatum As String | |
| 59 | + | filterDatum = Format(Now, "mm/dd/yyyy hh:nn AMPM") | |
| 60 | + | Set gefilterteItems = olItems.Restrict("[Start] >= '" & filterDatum & "'") | |
| 59 | 61 | ||
| 60 | 62 | On Error Resume Next | |
| 61 | 63 | Set logSheet = ThisWorkbook.Sheets("Gelöschte Termine") | |
lerone revised this gist . Go to revision
1 file changed, 1 insertion, 1 deletion
gistfile1.txt
| @@ -74,7 +74,7 @@ Sub SerienKalendereintraegeErstellen() | |||
| 74 | 74 | For i = 2 To lastRow | |
| 75 | 75 | If alreadyProcessed(i) Then GoTo Weiter | |
| 76 | 76 | ||
| 77 | - | If ws.Cells(i, "B").Value < Date Then | |
| 77 | + | If ws.Cells(i, "B").Value < DateSerial(Year(Date), Month(Date), Day(Date)) Then | |
| 78 | 78 | ws.Cells(i, "M").Value = "übersprungen (Vergangenheit)" | |
| 79 | 79 | uebersprungenCount = uebersprungenCount + 1 | |
| 80 | 80 | GoTo Weiter | |
lerone revised this gist . Go to revision
No changes
lerone revised this gist . Go to revision
1 file changed, 3 insertions, 3 deletions
gistfile1.txt
| @@ -129,7 +129,7 @@ SkipJ: | |||
| 129 | 129 | If DRYRUN Then | |
| 130 | 130 | ws.Cells(idx, "M").Value = "[Simulation] Einzel: " & titel | |
| 131 | 131 | Else | |
| 132 | - | Call OutlookEintragErstellen(gefilteteItems, datum, startzeit, endzeit, titel, ort, veranstaltungsnummer) | |
| 132 | + | Call OutlookEintragErstellen(selectedCalendar, gefilteteItems, datum, startzeit, endzeit, titel, ort, veranstaltungsnummer) | |
| 133 | 133 | ws.Cells(idx, "M").Value = titel | |
| 134 | 134 | End If | |
| 135 | 135 | ws.Cells(idx, "N").Value = IIf(DRYRUN, "(Simulation)", selectedCalendar.Name) | |
| @@ -190,7 +190,7 @@ End Sub | |||
| 190 | 190 | ||
| 191 | 191 | ||
| 192 | 192 | ' Hilfsfunktion zum Erstellen eines Einzeltermins | |
| 193 | - | Sub OutlookEintragErstellen(ByVal gefilteteItems As Object, ByVal datum As Date, ByVal startzeit As Date, ByVal endzeit As Date, ByVal titel As String, ByVal ort As String, ByVal veranstaltungsnummer As String) | |
| 193 | + | Sub OutlookEintragErstellen(ByVal selectedCalendar As Object, ByVal gefilteteItems As Object, ByVal datum As Date, ByVal startzeit As Date, ByVal endzeit As Date, ByVal titel As String, ByVal ort As String, ByVal veranstaltungsnummer As String) | |
| 194 | 194 | Dim item As Object, existingItem As Object | |
| 195 | 195 | Dim itemDate As Date | |
| 196 | 196 | Dim bodyText As String | |
| @@ -218,7 +218,7 @@ Sub OutlookEintragErstellen(ByVal gefilteteItems As Object, ByVal datum As Date, | |||
| 218 | 218 | End If | |
| 219 | 219 | Next | |
| 220 | 220 | ||
| 221 | - | Set item = Application.GetNamespace("MAPI").GetDefaultFolder(9).Items.Add | |
| 221 | + | Set item = selectedCalendar.Items.Add | |
| 222 | 222 | With item | |
| 223 | 223 | .Start = datum + startzeit | |
| 224 | 224 | .End = datum + endzeit | |
lerone revised this gist . Go to revision
1 file changed, 11 insertions, 8 deletions
gistfile1.txt
| @@ -50,10 +50,13 @@ Sub SerienKalendereintraegeErstellen() | |||
| 50 | 50 | ||
| 51 | 51 | Set selectedCalendar = allCalendars(selectedIndex) | |
| 52 | 52 | MsgBox "Ausgewählter Kalender: " & selectedCalendar.Name, vbInformation, "Kalenderbestätigung" | |
| 53 | - | Set olItems = selectedCalendar.Items.Restrict("[Start] >= '" & Format(Date, "ddddd h:nn AMPM") & "'") | |
| 53 | + | Set olItems = selectedCalendar.Items | |
| 54 | 54 | olItems.Sort "[Start]" | |
| 55 | 55 | olItems.IncludeRecurrences = True | |
| 56 | 56 | ||
| 57 | + | Dim gefilterteItems As Object | |
| 58 | + | Set gefilterteItems = olItems.Restrict("[Start] >= '" & Format(Date, "ddddd h:nn AMPM") & "'") | |
| 59 | + | ||
| 57 | 60 | On Error Resume Next | |
| 58 | 61 | Set logSheet = ThisWorkbook.Sheets("Gelöschte Termine") | |
| 59 | 62 | If logSheet Is Nothing Then | |
| @@ -126,7 +129,7 @@ SkipJ: | |||
| 126 | 129 | If DRYRUN Then | |
| 127 | 130 | ws.Cells(idx, "M").Value = "[Simulation] Einzel: " & titel | |
| 128 | 131 | Else | |
| 129 | - | Call OutlookEintragErstellen(olItems, datum, startzeit, endzeit, titel, ort, veranstaltungsnummer) | |
| 132 | + | Call OutlookEintragErstellen(gefilteteItems, datum, startzeit, endzeit, titel, ort, veranstaltungsnummer) | |
| 130 | 133 | ws.Cells(idx, "M").Value = titel | |
| 131 | 134 | End If | |
| 132 | 135 | ws.Cells(idx, "N").Value = IIf(DRYRUN, "(Simulation)", selectedCalendar.Name) | |
| @@ -136,7 +139,7 @@ SkipJ: | |||
| 136 | 139 | For Each idx In eintraege | |
| 137 | 140 | datum = ws.Cells(idx, "B").Value | |
| 138 | 141 | If Not DRYRUN Then | |
| 139 | - | Call OutlookEintragLoeschen(olItems, datum, titel, logSheet, selectedCalendar.Name) | |
| 142 | + | Call OutlookEintragLoeschen(gefilteteItems, datum, titel, logSheet, selectedCalendar.Name) | |
| 140 | 143 | geloeschtCount = geloeschtCount + 1 | |
| 141 | 144 | End If | |
| 142 | 145 | Next idx | |
| @@ -187,12 +190,12 @@ End Sub | |||
| 187 | 190 | ||
| 188 | 191 | ||
| 189 | 192 | ' Hilfsfunktion zum Erstellen eines Einzeltermins | |
| 190 | - | Sub OutlookEintragErstellen(ByVal olItems As Object, ByVal datum As Date, ByVal startzeit As Date, ByVal endzeit As Date, ByVal titel As String, ByVal ort As String, ByVal veranstaltungsnummer As String) | |
| 193 | + | Sub OutlookEintragErstellen(ByVal gefilteteItems As Object, ByVal datum As Date, ByVal startzeit As Date, ByVal endzeit As Date, ByVal titel As String, ByVal ort As String, ByVal veranstaltungsnummer As String) | |
| 191 | 194 | Dim item As Object, existingItem As Object | |
| 192 | 195 | Dim itemDate As Date | |
| 193 | 196 | Dim bodyText As String | |
| 194 | 197 | ||
| 195 | - | For Each existingItem In olItems | |
| 198 | + | For Each existingItem In gefilteteItems | |
| 196 | 199 | If existingItem.Class = 26 Then ' nur AppointmentItems | |
| 197 | 200 | itemDate = Int(existingItem.Start) | |
| 198 | 201 | If itemDate = datum Then | |
| @@ -215,7 +218,7 @@ Sub OutlookEintragErstellen(ByVal olItems As Object, ByVal datum As Date, ByVal | |||
| 215 | 218 | End If | |
| 216 | 219 | Next | |
| 217 | 220 | ||
| 218 | - | Set item = olItems.Add | |
| 221 | + | Set item = Application.GetNamespace("MAPI").GetDefaultFolder(9).Items.Add | |
| 219 | 222 | With item | |
| 220 | 223 | .Start = datum + startzeit | |
| 221 | 224 | .End = datum + endzeit | |
| @@ -230,10 +233,10 @@ End Sub | |||
| 230 | 233 | ||
| 231 | 234 | ||
| 232 | 235 | ' Hilfsfunktion zum Löschen vorhandener Einzeltermine mit gleichem Titel am gegebenen Datum | |
| 233 | - | Sub OutlookEintragLoeschen(ByVal olItems As Object, ByVal datum As Date, ByVal titel As String, ByVal logSheet As Worksheet, ByVal kalenderName As String) | |
| 236 | + | Sub OutlookEintragLoeschen(ByVal gefilteteItems As Object, ByVal datum As Date, ByVal titel As String, ByVal logSheet As Worksheet, ByVal kalenderName As String) | |
| 234 | 237 | Dim item As Object | |
| 235 | 238 | Dim itemDate As Date | |
| 236 | - | For Each item In olItems | |
| 239 | + | For Each item In gefilteteItems | |
| 237 | 240 | If item.Class = 26 Then ' nur AppointmentItems | |
| 238 | 241 | itemDate = Int(item.Start) | |
| 239 | 242 | If itemDate = datum And item.Subject = titel Then | |
lerone revised this gist . Go to revision
1 file changed, 3 insertions, 2 deletions
gistfile1.txt
| @@ -49,9 +49,10 @@ Sub SerienKalendereintraegeErstellen() | |||
| 49 | 49 | If Not IsNumeric(selectedIndex) Or selectedIndex < 1 Or selectedIndex > allCalendars.Count Then Exit Sub | |
| 50 | 50 | ||
| 51 | 51 | Set selectedCalendar = allCalendars(selectedIndex) | |
| 52 | - | Set olItems = selectedCalendar.Items | |
| 53 | - | olItems.IncludeRecurrences = True | |
| 52 | + | MsgBox "Ausgewählter Kalender: " & selectedCalendar.Name, vbInformation, "Kalenderbestätigung" | |
| 53 | + | Set olItems = selectedCalendar.Items.Restrict("[Start] >= '" & Format(Date, "ddddd h:nn AMPM") & "'") | |
| 54 | 54 | olItems.Sort "[Start]" | |
| 55 | + | olItems.IncludeRecurrences = True | |
| 55 | 56 | ||
| 56 | 57 | On Error Resume Next | |
| 57 | 58 | Set logSheet = ThisWorkbook.Sheets("Gelöschte Termine") | |
lerone revised this gist . Go to revision
1 file changed, 5 insertions
gistfile1.txt
| @@ -90,6 +90,11 @@ Sub SerienKalendereintraegeErstellen() | |||
| 90 | 90 | hinweis = Mid(hinweis, InStr(hinweis, "Lehrgang: ") + 10) | |
| 91 | 91 | End If | |
| 92 | 92 | titel = produkt & " - " & hinweis | |
| 93 | + | If Trim(titel) = "-" Or Trim(titel) = "- -" Or Trim(titel) = "" Then | |
| 94 | + | ws.Cells(i, "M").Value = "übersprungen (leerer Titel)" | |
| 95 | + | uebersprungenCount = uebersprungenCount + 1 | |
| 96 | + | GoTo Weiter | |
| 97 | + | End If | |
| 93 | 98 | ort = ws.Cells(i, "J").Value | |
| 94 | 99 | ||
| 95 | 100 | datum = ws.Cells(i, "B").Value | |