in meine Excelanwendung möchte ich gern die Wochenübersicht (aktuelle Woche) des Outlook-Kalenders importieren. Bislang habe ich den Umweg über einen Export in Outlook, dann wieder import in Excel gewählt. Hat jemand einen Tipp?
Danke und Gruß
Jens
Sub sGetAllTermine()
Dim dStart As Date
Dim dEnde As Date
Dim objApp As Outlook.Application
Dim objKalender As MAPIFolder
Dim objAppts As Items
Dim objItem As AppointmentItem
Dim lngCount As Long
On Error GoTo PROC_Err
Set objApp = CreateObject("Outlook.Application")
Set objKalender = objApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
Set objAppts = objKalender.Items
If objAppts Is Nothing Then Exit Sub
If objAppts.Count = 0 Then Exit Sub
' Datum eingrenzen
dStart = InputBox("Bitte das Startdatum eingeben:", "Startdatum", Date)
dEnde = InputBox("Bitte das Enddatum eingeben:", "Enddatum ", Date)
Set objAppts = objAppts.Restrict("[Start] >= '#" & dStart & "#' AND [End] <= '#" & dEnde & "#'")
' Sortierung!
objAppts.Sort ["Start"], False
Set objItem = objAppts.GetFirst
Do While TypeName(objItem) <> "Nothing"
With objItem
Debug.Print .Subject, .Start, .End, .AllDayEvent
' Hier alle benötigen Felder auslesen und in die Tabelle einschreiben
End With
Set objItem = objAppts.GetNext
Loop
PROC_Exit:
On Error Resume Next
Set objAppts = Nothing
Set objKalender = Nothing
Set objApp = Nothing
Exit Sub
PROC_Err:
MsgBox Err.Description, vbCritical, "Fehler #" & Err.Number
Resume PROC_Exit
End Sub