moechte gerne per vba in excel die outlook-termine einlesen.
wenn es geht, natuerlich nur die künftigen termine (datum >=heute),
also keine alten.
ich habe hier zwar etwas gefunden, funktioniert aber nicht
er bleibt bei
For Each Termin In olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
hängen :=((
hat jemand einen tip
wuerde mich sehr freuen
gruss
stefan
hier der code
Sub Kalenderdaten_einlesen()
'Zunächst Verweis auf OL-Bibliothek erstellen >> hab ich auch gemacht
Dim olApp As Outlook.Application
Dim Termin As Outlook.AppointmentItem
Dim i As Long, j As Long
Set olApp = New Outlook.Application
'Falls man mal einen Termin erstellen möchte:
'Set Termin = olApp.CreateItem(olAppointmentItem)
i = 1
Application.ScreenUpdating = False
Cells(i, 1) = "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
If Not Termin.AllDayEvent Then Trag_ein Termin, i, False
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) = "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
If Termin.AllDayEvent And Not Termin.IsRecurring Then Trag_ein Termin, i, True
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 + 1
j = i
Cells(i, 1) = "Betreff"
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 Termin.AllDayEvent And Termin.IsRecurring Then Trag_ein Termin, i, True
Next
Range("C" & j).Select
Range("A1:F" & Range("A" & j).CurrentRegion.Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess
Set Termin = Nothing
Set olApp = Nothing
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Sub Trag_ein(Termin As AppointmentItem, i As Long, Ereignis As Boolean)
Dim Anzeigen_als As String
Dim Spalte As Integer
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