Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Outlook Termine mit Excel importieren
#1
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


Angehängte Dateien Thumbnail(s)
   
Antwortento top
#2
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
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#3
Hi Jan,

(21.09.2020, 08:54)Jan1403 schrieb: 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
Antwortento top
#4
Hi Ralf,

bei mir war das glaube eine Terminserie, auch mit Anfang und Ende ...
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste