Outlook Termine mit Excel importieren

[Jan1403]

Hallo zusammen,

ich habe eine Frage bezüglich eines Makros, mit dem man Termine aus einer Excel Tabelle in Outlook importieren kann.
Mit dem folgenden Code funktioniert es bereits, dass durch das drücken auf eine Schaltfläche alle darin enthaltenen Termine in Outlook exportiert werden.

Code:

Sub createAppointments()
    On Error Resume Next
    Dim sheet As Worksheet, rngStart As Range, rngEnd As Range, cell As Range
    Set objOL = CreateObject("Outlook.Application")
    Set objCal = objOL.Session.Stores.Item("test@test.de").GetDefaultFolder(9).Folders.Item("Excel Test")
    Set sheet = Worksheets("Termine")
    Set rngStart = sheet.Range("A2")
    Set rngEnd = rngStart.End(xlDown)
    counter = 0
    For Each cell In sheet.Range(rngStart, rngEnd)
            strSubject = cell.Text
            strStartDate = cell.Offset(0, 1).Text
            strStartTime = cell.Offset(0, 2).Text
            strEndDate = cell.Offset(0, 3).Text
            strEndTime = cell.Offset(0, 4).Text
            boolAllDay = cell.Offset(0, 5).Value
            strLocation = cell.Offset(0, 6).Text
            strComment = cell.Offset(0, 7).Text
            boolReminderSet = cell.Offset(0, 8).Value = True
           
            'Eventuelles Duplikat des Termins finden ---------
            Set allItems = objCal.items
            allItems.Sort "[Start]"
            ' Ganztagestermin oder normaler Termin unterscheiden
            If boolAllDay = True Then
                ' Filtere Termine nach Ganztagesevents zu dieser Zeit und dem Betreff
                Set dupe_item = allItems.Restrict("[Start]=""" & Format(strStartDate, "dd.mm.yyyy hh:mm") & """ AND [END]= """ & Format(DateAdd("d", 1, DateValue(strEndDate)), "dd.mm.yyyy hh:mm") & """ AND [Subject] = '" & strSubject & "' AND [AllDayEvent] = True")
            Else
                ' Filtere normale Termine zu dieser Zeit und dem Betreff
                Set dupe_item = allItems.Restrict("[Start]=""" & Format(strStartDate, "dd.mm.yyyy" & strStartTime, "hh:mm") & """ AND [END]= """ & Format(strEndDate, "dd.mm.yyyy" & strEndTime, "hh:mm") & """ AND [Subject] = '" & strSubject & "' AND [AllDayEvent] = False")
            End If
            ' hole den ersten passenden Termin wenn er exisitiert
            Set itm = dupe_item.GetFirst
   
            If itm Is Nothing Then
                ' erstelle neuen Termin wenn kein Duplikat exisitert
                Set olApp = objCal.items.Add(1)
            Else
                ' verwende den gefundenen Termin
                Set olApp = itm
            End If
       
            With olApp
                .Location = strLocation
                .ReminderSet = boolReminderSet
                .Subject = strSubject
                .Body = strComment
                If boolAllDay = True Then
                    .AllDayEvent = True
                    If IsDate(strStartDate) Then
                        .Start = DateValue(strStartDate)
                        .End = DateAdd("d", 1, DateValue(strStartDate))
                        .Save
                        counter = counter + 1
                    Else
                        MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation
                    End If
                Else
                    .AllDayEvent = False
                    If IsDate(strStartDate) And IsDate(strEndDate) And IsDate(strStartTime) And IsDate(strEndTime) Then
                        .Start = DateValue(strStartDate) & " " & TimeValue(strStartTime)
                        .End = DateValue(strEndDate) & " " & TimeValue(strEndTime)
                        .Save
                        counter = counter + 1
                    Else
                        MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation
                    End If
                End If
            End With
            Set olApp = Nothing
        Next
        Set objOL = Nothing
        MsgBox counter & " Termin(e) wurde(n) erstellt!", vbInformation
    End Sub

Mir fehlen allerdings noch drei Funktionen, bei denen ich leider nicht weiß wie ich diese umsetzen kann.


- Duplikate sollen geändert und nicht nochmal hinzugefügt werden

- Jeder Termin soll einzeln dem Kalender hinzugefügt werden können

- Termine löschen

Ich hoffe jemand kann mir weiterhelfen und weiß, wie man so etwas implementieren kann.

Viele Grüße
Jan

[schauan]

Hallöchen,

schaue mal, ob das schon helfen kann. Da hab ich z.B. doppelte Eintragungen verhindert

Ampelfunktion-mit-Email-oder-Outlookkalender-verbinden?pid=177601#pid177601

[Rabe]

Hi Jan,

Mir fehlen allerdings noch drei Funktionen, bei denen ich leider nicht weiß wie ich diese umsetzen kann.
- Duplikate sollen geändert und nicht nochmal hinzugefügt werden
- Jeder Termin soll einzeln dem Kalender hinzugefügt werden können
- Termine löschen

Ich hoffe jemand kann mir weiterhelfen und weiß, wie man so etwas implementieren kann.

Dies ist ein interessantes Thema und ich habe es vorletzte Woche auch schon versucht, hatte dann aber keine Zeit mehr.
Nun werde ich Dein Makro mal testen.

Ich habe noch eine Funktion, die ich gerne hätte:
- Terminserien, also z.B. Import einer Geburtstagsliste

Hat jemand damit auch schon experimentiert oder das umgesetzt?

Gruß Ralf

[schauan]

Hi Ralf,

bei mir war das glaube eine Terminserie, auch mit Anfang und Ende ...