Alle Kalender aus Outlook auslesen und in Excel Datei speichern

Korvinus · 27. April 2017, 15:11

Hallo,

ich möchte alle meine Kalendereinträge auslesen und in einer Excel-Datei speichern oder in einer CSV-Datei speichern.
Ich habe bisher entweder die Möglichkeit gehabt, manuell per Export den Kalender als CSV-Datei zu speichern.
Leider ist da nur mein Kalender und komischerweise auch ein Kalender den ein Kollege geteilt hat mit drin, aber nicht alle Kalender die ich in Outlook habe.

Ich habe ein Skript, welches meine Kalendereinträge in eine Excel-Datei einliest, leider nicht die anderen Kalender.
Im Skript habe ich folgendes stehen:

Visual Basic-Quellcode

'Durchlaufe alle Termine des aktuellen Standardkalenders
i = i + 1
For Each Termin In olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
Set myTerminPatt = Termin.GetRecurrencePattern
If Format(Termin.Start, "dd.mm.yyyy") >= startDate And Format(Termin.End, "dd.mm.yyyy") <= endDate Then
If Not Termin.AllDayEvent Then Trag_ein Termin, i, False
End If
If myTerminPatt.RecurrenceType = olRecursDaily Then
If Format(myTerminPatt.PatternEndDate, "dd.mm.yyyy") >= startDate Then
Trag_ein_Recurr Termin, i, False, startDate, endDate
End If
End If
Next
Range("C1").Select
Range("A1:H" & Range("A1").CurrentRegion.Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess

[/font]Ich möchte aber alle Kalender auslesen und in der Tabelle einspeichern und nicht nur den Standardkalender.
Kann Mir da vielleicht Jemand helfen?

~blaze~: Neu formatiert, Thema verschoben

Alter Code

'Durchlaufe alle Termine des aktuellen Standardkalenders
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']i = i + 1[/font]
For Each [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Termin [/font]In [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items[/font]
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]Set [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']myTerminPatt = Termin.GetRecurrencePattern[/font]
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]If [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Format(Termin.Start, "dd.mm.yyyy") >= startDate [/font]And [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Format(Termin.End, "dd.mm.yyyy") <= endDate [/font]Then
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]If Not [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Termin.AllDayEvent [/font]Then [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Trag_ein Termin, i, [/font]False
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]End If
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]If [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']myTerminPatt.RecurrenceType = olRecursDaily [/font]Then
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]If [font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Format(myTerminPatt.PatternEndDate, "dd.mm.yyyy") >= startDate [/font]Then
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] Trag_ein_Recurr Termin, i, [/font]False[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'], startDate, endDate[/font]
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]End If
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)'] [/font]End If
Next
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Range("C1").Select[/font]
[font='Arial, FixedSys; font-size: small; background-color: rgb(204, 204, 204)']Range("A1:H" & Range("A1").CurrentRegion.Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess

petaod · 28. April 2017, 00:35

Wenn du jetzt den Code noch lesbar in die passenden Tags packst, schaue ich mir das vielleicht an.
So jedenfalls ist es mir zu lästig.

~blaze~ · 30. April 2017, 10:59

Hi
ich habe den Code mal umformatiert. Bitte zukünftig darauf achten, dass die Codes richtig dargestellt werden und das richtige Unterforum auswählen.

Viele Grüße
~blaze~

petaod · 1. Mai 2017, 01:30

Korvinus schrieb:

Ich möchte aber alle Kalender auslesen ... und nicht nur den Standardkalender

Es kommt darauf an, wo sich der Kalender befindet.
Hier gibt es die richtige Zugriffsmethode für alle Varianten.

Korvinus · 4. Mai 2017, 09:56

Danke schonmal für die Hilfe. Es geht darum, dass ich meinen Standardkalender habe und möchte die anderen Kalender, welche freigegeben wurden ebenfalls in die selbe Excel-Datei auslesen.

Spoiler anzeigen

Visual Basic-Quellcode

Option Explicit
Sub Kalenderdaten_auf_Terminbereich_einlesen()
'(C) Ramses
'Zunächst Verweis auf OL-Bibliothek erstellen
'Early Binding ab Outlook 2003 nicht möglich
'weil die Rückgabewerte der ITEM-Indexes zufällig ist und von der
'Installation abhängt !!
'-------------
'Version Office 2000 (nicht getestet sollte aber tun)
'Dim olApp As Outlook.Application
'Dim Termin As Outlook.AppointmentItem
'Dim myTerminPatt As Outlook.RecurrencePattern
'-------------
'Set olApp = New outlook.Application
'Set Termin = olApp.CreateItem(olAppointmentItem)
'-------------
'Version XP
Dim olApp As Object
Dim Termin As Object
Set olApp = CreateObject("Outlook.Application")
'Allgemein gültig
Dim i As Long, j As Long, myErr As Integer
Dim startInput As String, startDate As Date
Dim endInput As String, endDate As Date
Dim myTerminPatt As Object
On Error GoTo myErrorhandler
'Erst mal alles löschen
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
'Startdatum abfragen
startInput = InputBox("Bitte Datum eingeben im Format ""01.01.2004""", "Datum für Terminsuche", Format(Now, "dd.mm.yyyy"))
myErr = 1
If startInput = "" Then
MsgBox "Abbruch des Makros durch Benutzer"
Exit Sub
ElseIf Not IsDate(DateValue(startInput)) Then
MsgBox "Falsches Datum eingegeben"
Exit Sub
End If
myErr = 2
endInput = InputBox("Bitte Datum eingeben im Format ""01.01.2004""", "Datum für Terminsuche", Format(DateValue(startInput) + 7, "dd.mm.yyyy"))
If endInput = "" Then
MsgBox "Abbruch des Makros durch Benutzer"
Exit Sub
ElseIf Not IsDate(DateValue(endInput)) Then
MsgBox "Falsches Datum eingegeben"
Exit Sub
End If
myErr = 0
'Variable definitiv zuweisen
startDate = DateValue(startInput)
endDate = DateValue(endInput)
'Variable fü¨r Termin neu setzen
'Set Termin = olApp.CreateItem(Appointment)
Cells(1, 1) = "Termine vom " & Format(startDate, "dd.mm.yyyy") & " bis " & Format(endDate, "dd.mm.yyyy")
i = 3
Application.ScreenUpdating = False
Cells(i, 1) = "Termin Betreff"
Cells(i, 2) = "Inhalt/Body"
Cells(i, 3) = "Start"
Cells(i, 4) = "Ende"
Cells(i, 5) = "Erinnerung Minuten"
Cells(i, 6) = "Anzeigen als"
Cells(i, 7) = "Kategorien"
Cells(i, 8) = "Erstellt am"
Range(Cells(i, 1), Cells(i, 8)).Select
Selection.Interior.ColorIndex = 15
'Durchlaufe alle Termine des aktuellen Standardkalenders
i = i + 1
For Each Termin In olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
Set myTerminPatt = Termin.GetRecurrencePattern
If Format(Termin.Start, "dd.mm.yyyy") >= startDate And Format(Termin.End, "dd.mm.yyyy") <= endDate Then
If Not Termin.AllDayEvent Then Trag_ein Termin, i, False
End If
If myTerminPatt.RecurrenceType = olRecursDaily Then
If Format(myTerminPatt.PatternEndDate, "dd.mm.yyyy") >= startDate Then
Trag_ein_Recurr Termin, i, False, startDate, endDate
End If
End If
Next
Range("C1").Select
Range("A1:H" & Range("A1").CurrentRegion.Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess
'Jetzt die Ereignisse
i = i + 1
j = i
Cells(i, 1) = "Ganzer Tag Betreff"
Cells(i, 2) = "Ereignis am"
Cells(i, 3) = "Erinnerung Minuten"
Cells(i, 4) = "Anzeigen als"
Cells(i, 5) = "Kategorien"
Cells(i, 6) = "Erstellt am"
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Interior.ColorIndex = 15
i = i + 1
For Each Termin In olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
Debug.Print Termin.Start
If DateSerial(Year(startDate), Month(Termin.Start), Day(Termin.Start)) >= startDate And DateSerial(Year(startDate), Month(Termin.Start), Day(Termin.Start)) <= endDate Then
If Termin.AllDayEvent And Not Termin.IsRecurring Then Trag_ein Termin, i, True
End If
Next
Range("C" & j).Select
Range("A1:F" & Range("A" & j).CurrentRegion.Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess
'und noch die jährlichen Ereignisse
i = i + 2
j = i
Cells(i, 1) = "Betreff ""Jährliches Ereignis"""
Cells(i, 2) = "jährliches Ereignis am"
Cells(i, 3) = "Erinnerung Minuten"
Cells(i, 4) = "Anzeigen als"
Cells(i, 5) = "Kategorien"
Cells(i, 6) = "Erstellt am"
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Interior.ColorIndex = 15
i = i + 1
For Each Termin In olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
If DateSerial(Year(startDate), Month(Termin.Start), Day(Termin.Start)) >= startDate And DateSerial(Year(startDate), Month(Termin.Start), Day(Termin.Start)) <= endDate Then
If Termin.AllDayEvent And Termin.IsRecurring Then Trag_ein Termin, i, True
End If
Next
Range("C" & j).Select
Range("A1:F" & Range("A" & j).CurrentRegion.Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess
'Variablen leeren
Set Termin = Nothing
Set olApp = Nothing
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
Range("A1").Select
Cells.RowHeight = "12.75"
'Ausstieg
ErrorExit:
Application.ScreenUpdating = True
If myErr = 0 And Err.Number = 0 Then
MsgBox "Kalenderdaten eingelesen"
End If
Exit Sub
myErrorhandler:
Select Case myErr
Case 1
MsgBox "Ungültiges Startdatum"
Resume ErrorExit
Case 2
MsgBox "Ungültiges Enddatum"
Resume ErrorExit
End Select
MsgBox Err.Number & " " & Err.Description
Resume ErrorExit
End Sub
Sub Trag_ein(Termin, i As Long, Ereignis As Boolean)
Dim Anzeigen_als As String
Dim Erinnerung As String
Select Case Termin.BusyStatus
Case olFree
Anzeigen_als = "Frei"
Case olTentative
Anzeigen_als = "Unter Vorbehalt"
Case olBusy
Anzeigen_als = "Gebucht"
Case olOutOfOffice
Anzeigen_als = "Abwesend"
End Select
Cells(i, 1) = Termin.Subject
If Not Ereignis Then
Cells(i, 2) = Termin.Body
Cells(i, 3) = Termin.Start
Cells(i, 3).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 4) = Termin.End
Cells(i, 4).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 5) = Termin.ReminderMinutesBeforeStart
Cells(i, 6) = Anzeigen_als
Cells(i, 7) = Termin.Categories
Cells(i, 8) = Termin.CreationTime
Else
Cells(i, 2) = Termin.Start
Cells(i, 2).NumberFormat = "dd/mm/yyyy hh:mm"
If Termin.ReminderMinutesBeforeStart <= 60 Then
Erinnerung = Termin.ReminderMinutesBeforeStart & " Minuten"
ElseIf Termin.ReminderMinutesBeforeStart / 60 < 24 Then
Erinnerung = Termin.ReminderMinutesBeforeStart / 60 & " Stunden"
Else
Erinnerung = Termin.ReminderMinutesBeforeStart / 60 / 24 & " Tage"
End If
Cells(i, 3) = Erinnerung
Cells(i, 3).NumberFormat = "General"
Cells(i, 4) = Anzeigen_als
Cells(i, 5) = Termin.Categories
Cells(i, 6) = Termin.CreationTime
End If
i = i + 1
End Sub
Sub Trag_ein_Recurr(Termin, i As Long, Ereignis As Boolean, startDate As Date, endDate As Date)
Dim Anzeigen_als As String
Dim Erinnerung As String
Dim n As Integer
Dim myReccTermin As Object
Select Case Termin.BusyStatus
Case olFree
Anzeigen_als = "Frei"
Case olTentative
Anzeigen_als = "Unter Vorbehalt"
Case olBusy
Anzeigen_als = "Gebucht"
Case olOutOfOffice
Anzeigen_als = "Abwesend"
End Select
Set myReccTermin = Termin.GetRecurrencePattern
If startDate = endDate Then
Cells(i, 1) = Termin.Subject
Cells(i, 3) = startDate + (i - 1)
Cells(i, 3).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 4) = startDate + (i - 1)
Cells(i, 4).Interior.ColorIndex = 3
Cells(i, 4).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 5) = Termin.ReminderMinutesBeforeStart
Cells(i, 6) = Anzeigen_als
Cells(i, 7) = Termin.Categories
Cells(i, 8) = Termin.CreationTime
i = i + 1
Set myReccTermin = Nothing
Exit Sub
End If
If myReccTermin.PatternEndDate < endDate Then
Debug.Print myReccTermin.PatternEndDate
If myReccTermin.PatternStartDate > startDate Then
For n = 1 To endDate - myReccTermin.PatternEndDate '(myReccTermin.PatternStartDate - startDate)
Cells(i, 1) = Termin.Subject
Cells(i, 3) = myReccTermin.PatternStartDate + n
Cells(i, 3).Interior.ColorIndex = 3
Cells(i, 3).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 4) = myReccTermin.PatternStartDate + n
Cells(i, 4).Interior.ColorIndex = 3
Cells(i, 4).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 5) = Termin.ReminderMinutesBeforeStart
Cells(i, 6) = Anzeigen_als
Select Case myReccTermin.RecurrenceType
Case 1
Cells(i, 7) = "Täglich"
Case 2, 3
Cells(i, 7) = "Monatlich"
Case 4
Cells(i, 7) = "Wöchentlich"
Case 5, 6
Cells(i, 7) = "Jährlich"
Case Else
Cells(i, 7) = "Serie"
End Select
Cells(i, 8) = Termin.CreationTime
i = i + 1
Next n
Else
For n = 1 To myReccTermin.PatternEndDate - startDate
Cells(i, 1) = Termin.Subject
Cells(i, 3) = startDate + n
Cells(i, 3).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 4) = startDate + n
Cells(i, 4).Interior.ColorIndex = 3
Cells(i, 4).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 5) = Termin.ReminderMinutesBeforeStart
Cells(i, 6) = Anzeigen_als
Select Case myReccTermin.RecurrenceType
Case 1
Cells(i, 7) = "Täglich"
Case 2, 3
Cells(i, 7) = "Monatlich"
Case 4
Cells(i, 7) = "Wöchentlich"
Case 5, 6
Cells(i, 7) = "Jährlich"
Case Else
Cells(i, 7) = "Serie"
End Select
Cells(i, 8) = Termin.CreationTime
i = i + 1
Next n
End If
End If
If myReccTermin.PatternEndDate > endDate Then
If myReccTermin.PatternStartDate > startDate Then
For n = 1 To endDate - myReccTermin.PatternStartDate
Cells(i, 1) = Termin.Subject
Cells(i, 3) = myReccTermin.PatternStartDate + n
Cells(i, 3).Interior.ColorIndex = 3
Cells(i, 3).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 4) = myReccTermin.PatternStartDate + n
Cells(i, 4).Interior.ColorIndex = 3
Cells(i, 4).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 5) = Termin.ReminderMinutesBeforeStart
Cells(i, 6) = Anzeigen_als
Select Case myReccTermin.RecurrenceType
Case 1
Cells(i, 7) = "Täglich"
Case 2, 3
Cells(i, 7) = "Monatlich"
Case 4
Cells(i, 7) = "Wöchentlich"
Case 5, 6
Cells(i, 7) = "Jährlich"
Case Else
Cells(i, 7) = "Serie"
End Select
Cells(i, 8) = Termin.CreationTime
i = i + 1
Next n
Else
For n = 1 To myReccTermin.PatternEndDate - startDate
Cells(i, 1) = Termin.Subject
Cells(i, 3) = startDate + n
Cells(i, 3).Interior.ColorIndex = 3
Cells(i, 3).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 4) = startDate + n
Cells(i, 4).Interior.ColorIndex = 3
Cells(i, 4).NumberFormat = "dd/mm/yyyy hh:mm"
Cells(i, 5) = Termin.ReminderMinutesBeforeStart
Cells(i, 6) = Anzeigen_als
Select Case myReccTermin.RecurrenceType
Case 1
Cells(i, 7) = "Täglich"
Case 2, 3
Cells(i, 7) = "Monatlich"
Case 4
Cells(i, 7) = "Wöchentlich"
Case 5, 6
Cells(i, 7) = "Jährlich"
Case Else
Cells(i, 7) = "Serie"
End Select
Cells(i, 8) = Termin.CreationTime
i = i + 1
Next n
End If
End If
Set myReccTermin = Nothing
End Sub

Das ist der Code, welcher bei Drücken eines Buttons die Termine einliest. Aber leider nur die des Standartkalenders.

*Spoiler-BBCode eingefügt*

petaod · 4. Mai 2017, 13:02

Es wäre wesentlich einfacher, wenn du deinen Code etwas modularer aufgebaut hättest.
Von objektorientiert wage ich ja gar nicht zu reden.
Geh weg vom Spaghetti-Code und versuche, Struktur in dein Programm zu bringen.

Du musst halt eben, da wo du den Kalender holst (z.B. Zeile 72), statt .GetDefaultFolder die entsprechenden anderen Verfahren anwenden, um an deine gewünschte Kalender zu kommen.

Korvinus · 4. Mai 2017, 15:33

Danke für den Tipp,

ich programmiere sonst nur Java(natürlich Objektorientiert).
Aber in VB habe ich ehrlich gesagt noch nichts drauf und diesen Code nur im Internet gefunden.
Leider ist ein VB-Skript das Einzige was ich für diesen Zweck gefunden habe.
Ich habe auch in dieser Zeile andere Methoden eingefügt, leider kam es wiederholt zu Fehlermeldungen, nach dem ausführen.

13 Typen unverträglich. Irgendwie mag er nicht mehrere Termine zur selben Zeit.
Da muss wohl eine neue Tabelle her oder so

Ich probier mal ein bisschen herum und schaue ob es dann geht.
Falls Jemand mit mehr Erfahrung den Code ergänzen kann wäre das aber auch sehr hilfreich.

Vielen Dank schonmal im Vorraus für die Hilfe.

Gruß Korvi

Korvinus · 5. Mai 2017, 11:46

Nachtrag:

Ich habe es nicht hinbekommen =/

tgdwero3 · 4. November 2018, 20:31

Outlook kennt die Methode:

VB.NET-Quellcode

Outlook.Application.Session.GetFolderFromID(myEntryID, myStoreID)

, welche Dir ein Folder Objekt zurückgibt.

VB.NET-Quellcode

Set myDestFolder = Outlook.Application.Session.GetFolderFromID(myEntryID, myStoreID)

Die üble Sache daran ist, dass ich weder die myEntryID noch die myStoreID herleiten kann. Meine Lösung verwendet nun einen manuellen Eingriff:

VB.NET-Quellcode

Dim MyRootFolder As Outlook.MAPIFolder
Set MyRootFolder = Outlook.Application.Session.PickFolder

Jetzt kann ich auf die 3 relevanten Parameter ausgeben lassen (Name und die beiden IDs)

VB.NET-Quellcode

MsgBox MyRootFolder
MsgBox MyRootFolder.EntryID
MsgBox MyRootFolder.StoreID

Da mir Dein Anwendungsfalls noch nicht ganz klar ist (sollen mehrere Kalender in dasselbe Excel-Sheet ausgegeben oder reicht es, wenn jeweils ein Kalender manuell ausgewählt und ausgelesen wird), kann ich leider nicht weiterhelfen.

Alle Kalender aus Outlook auslesen und in Excel Datei speichern

Alle Kalender aus Outlook auslesen und in Excel Datei speichern

Visual Basic-Quellcode

Korvinus schrieb:

Visual Basic-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Ähnliche Themen

4 Benutzer haben hier geschrieben