Outlook Kalender Export per VBA
05.08.2020 10:12:22
Nikolai
gibt es die Möglichkeit in Outlook mit einem VBA Code den Kalender in eine Exceltabelle zu exportieren?
Dabei sollte nur folgendes exportiert werden:
Immer für das aktuelle Jahr
Spalte A: Termin Datum Beginn
Spalte B:Termin Beginn Uhrzeit
Spalte D:Termin Datum Ende
Spalte D:Termin Ende Uhrzeit
Spalte E: Ob Privat oder nicht
Spalte F: Ob Außer
Spalte G: Wem der Kalender gehört
Dies soll alle 30 Minuten aktualisiert werden und in einem ExcelWorkbook gespeichert werden.
Ich habe es zwar geschafft das Excel sich die Daten selber holt, aber so ist es sehr umständlich für die weitere Verwendung für die die Daten dann vorgesehen sind.
Der Code soll dann von 6 Mitarbeitern verwendet werden und somit 6 Excel Workbooks in einem Bestimmten Ordner erstellt werden. Es wäre zu umständlich das jeder der Mitarbeiter jeden Morgen die Exceldatei öffnet damit mein Code arbeiten kann. Outlook öffnet aber jeder von uns sowieso morgens.
Hier der Code den ich bis jetzt in Excel schreiben konnte:
Sub outlook_calendaritemsexport()
Dim o As Outlook.Application, R As Long
Set o = New Outlook.Application
Dim ons As Outlook.Namespace
Set ons = o.GetNamespace("MAPI")
Dim myfol As Outlook.Folder
Set myfol = ons.GetDefaultFolder(9)
Dim myapt As Outlook.AppointmentItem
Range("A1:z1").Value = Array("Von Datum", "Von Zeilt", "Bis Datum", "Bis Zeit", "Betreff")
R = 1000
For Each myapt In myfol.Items
Cells(R, 1).Value = myapt.Start
Cells(R, 2).Value = myapt.Start
Cells(R, 3).Value = myapt.End
Cells(R, 4).Value = myapt.End
Cells(R, 5).Value = myapt.Subject
R = R - 1
Next
Set o = Nothing
Set ons = Nothing
Set myfol = Nothing
Set myapt = Nothing
Application.OnTime Now + TimeValue("00:30:00"), "outlook_calendaritemsexport"
Cells.Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add2 Key:=Columns("A:A" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Columns("A:Z")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("B:B").Select
Selection.NumberFormat = "h:mm;@"
Columns("C:C").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("D:D").Select
Selection.NumberFormat = "h:mm;@"
End Sub
Würde mich sehr über euer Hilfe freuen. :)