Office: Ausgewählte Excel Termine per VBA in Outlook importieren

Hallo Forum,

ich habe ein merkwürdiges Problem und finde den Fehler nicht...

Ich habe in einer Exceldatei Termine gespeichert, die ich in einen Outlook Kalender importieren möchte.
Dies sind mal die Spaltenüberschriften:
Betreff | Beginnt am | Beginnt um | Beginn Datum + Zeit | Endet am | Endet um | Ende Datum + Zeit | Ganztägiges Ereignis | Beschreibung | Ort

Die Spalten Beginn Datum + Zeit sowie Ende Datum + Zeit werden für den Import verwendet und haben folgendes Format: dd.mm.yy hh:mm.

Ich hab die Tabelle nach den Juli-Terminen 2023 gefiltert - das sind insgesamt 11 Einträge.

Mit dem folgenden Code möchte ich die Tabelle durchgehen und die Termine in meinem Defaultkalender speichern:

Code:

Sub Outlook_Termin_Import()

'Outlook Bibbliotheken aktivieren
'Menue Extras --> Verweise --> Microsoft Outlook xx.x Object Library
 
'Variablen dimensionieren
Dim oApp As New Outlook.Application
Dim oNamespace As Outlook.Namespace
Dim oEmpfaenger As Outlook.Recipient

Dim sEmpfaengername As String           'Gewaehlter Outlook-Kalendername
Dim oOrdner As Outlook.Folder           'Gewaehlter Outlook-Ordner
Dim oTermin As Outlook.AppointmentItem  'Termin, der aus Excel in Outlook übernommen werden soll
 
Dim rFilter As Range            'Variable, um den gefilterten Bereich zu durchgehen
Dim rFilterposition As Range    'Variable, um den gefilterten Bereich zu durchgehen
 
'Namespace fuer Outlook Kalender (MAPI-Dateien) erstellen
Set oNamespace = oApp.GetNamespace("MAPI")
 

Set oEmpfaenger = oNamespace.CreateRecipient("xy")
    
oEmpfaenger.Resolve
 
'Pruefen, ob Empfaenger gefunden wurde
If oEmpfaenger.Resolved = False Then
 
    'Benutzer benachrichtigen
    MsgBox "Der Kalender wurde nicht gefunden", vbCritical, "Fehler"
 
    'Prozedur beenden
    Exit Sub
End If

Set oOrdner = oNamespace.GetSharedDefaultFolder(oEmpfaenger, olFolderCalendar)

'Filterbereich zuweisen
Set rFilter = Range("A2:A500").SpecialCells(xlCellTypeVisible)

'Termin erstellen
For Each rFilterposition In rFilter
 
    Set oTermin = oOrdner.Items.Add(olAppointmentItem)
 
    With oTermin
        .Subject = Tabelle2.Cells(rFilterposition.Row, 1).Value
        .Start = Tabelle2.Cells(rFilterposition.Row, 4).Value
        .End = Tabelle2.Cells(rFilterposition.Row, 7).Value
        .AllDayEvent = Tabelle2.Cells(rFilterposition.Row, 8).Value
        .Body = Tabelle2.Cells(rFilterposition.Row, 9).Value
        .Location = Tabelle2.Cells(rFilterposition.Row, 10).Value
        .Save
    End With
 
    Next rFilterposition
 
'Variablen leeren
Set oApp = Nothing
Set oTermin = Nothing
 
End Sub

Damit lande ich in einer Endlosschleife, welche mir Termine im Jahr 1899 erstellt.

Komisch dabei ist nur, dass ich den gleichen Code auch in einem geschäftlichen Kalender verwende und da klappt alles!

Hat jemand eine Idee, woran der Fehler liegen könnte?

Vielen Dank schonmal!

 

Interessant ist, dass die Raumbuchungen für die 11 Termine richtig vorgenommen wurden...

 

Hallo,

das was mir auf Anhieb aufgefallen ist, ohne dabei deine Daten zu kennen:

1) Du verwendest zur Festlegung der Variable rFilter den Range("A2:A500"), was bewirkt, dass dafür der Range des aktiven Arbeitsblattes verwendet wird, so als ob dort stünde:
Set rFilter = ActiveSheet.Range("A2:A500").SpecialCells(xlCellTypeVisible)
Wenn du damit tatsächlich immer ActiveSheet meinst, ist es so ok - ansonsten gibt es ein Problem, weil das falsche Arbeitsblatt verwendet wird.

2) Du verwendest den Objektnamen des Arbeitsblattes Tabelle2.
.Subject = Tabelle2.Cells(rFilterposition.Row, 1).Value
Solange ein solcher vorhanden ist, auf dem die Termindaten eingetragen sind, und der identisch ist mit dem Objektnamen von ActiveSheet von Punkt 1), ist alles ok.

3) Endlosschleife, welche mir Termine im Jahr 1899 erstellt.
Wo diese Endlosschleife auftreten soll, ist mir gänzlich unklar. Wenn das Jahr 1899 in einem Termin auftritt, so deutet das darauf hin, dass du auf eine "Termin"-Zelle zugreifst, die als Wert 0 (oder eine leere Zelle) enthält. In diesem Fall ergibt sich in VBA ein serielles Datum 30.12.1899, während eine solche Zelle im Arbeitsblatt als Datum formatiert den 31.12.1899 oder den 00.01.1900 anzeigt.
(Die Differenz ergibt sich wegen des Schaltjahr-Fehlers im Excel-Arbeitsblatt, das das Jahr 1900 als Schaltjahr behandelt - in VBA gibt es diesen Fehler nicht.).
Dieser Jahr-Fehler deutet darauf hin, dass es doch ein Problem zwischen Punkt 1) und Punkt 2) geben könnte.

 

Hallo Anton,

vielen Dank für deine Hinweise! Den ersten Punkt habe ich folgendermaßen korrigiert:
Set rFilter = Tabelle2.Range("A2:A500").SpecialCells(xlCellTypeVisible)

Der Fehler mit den Termineintragungen bliebt aber bestehen. Hier mal ein Screenshot von meinen Daten:

Betreff, Beschreibung und Ort hab ich mal gelöscht... der Ort ist ja auch nicht das Problem. Da werden die Termine richtig erstellt.
Hast du gerade spontan eine Idee?

Viele Grüße

 

Hallo rocknrolli,

und wenn Du in deinen markierten Zellen leere Zellen hat, erzeugst Du Termine am 30.12.1899, oder?

Probier doch mal nach dem

Code:

For Each rFilterposition In rFilter

eine If-Abfrage

Code:

If Cells(rFilterposition.Row, 4)<>"" then

Gruß,
Lutz