AW: Outlook Kalender nach Excel
20.07.2017 13:32:54
dirk
Hallo!
Hier mal ein Macro, welches das prinzipiell macht. Falsche Datumseingabe stoppt dieses.
Was meinst Du mit Kategorie?
Private Sub Outlook_Vba_Get_Calendar_Item_Appoinments()
Dim oWorkbook As Workbook, Calendar_To_Excel_File As String
Dim oOutlook_Calendar As Outlook.Folder, oCalendar_Items As Outlook.Items
Dim oCalendarAppointment As Outlook.AppointmentItem
Dim iRow As Double, StartDate As Date, EndDate As Date
Dim tmp As Variant
' first, ask for the start date
tmp = InputBox("Please enter the start date (dd/mm/yyyy)", "Start Date User Input")
If IsDate(tmp) = True Then
StartDate = tmp
Else
MsgBox "wrong start date entry, abort"
Exit Sub
End If
' second, ask for the end date
tmp = InputBox("Please enter the end date (dd/mm/yyyy)", "End Date User Input")
If IsDate(tmp) = True Then
EndDate = tmp
Else
MsgBox "wrong end date entry, abort"
Exit Sub
End If
iRow = 1
'Change path of the Target File name if required
Calendar_To_Excel_File = "D:\Sample23435.xlsx"
'Check if Output File already exists
If VBA.Dir(Calendar_To_Excel_File) = "" Then
'To Create New Workbook
Set oWorkbook = Workbooks.Add
oWorkbook.SaveAs Calendar_To_Excel_File
Else
'To Refer Already Created Workbook
Set oWorkbook = Workbooks.Open(Calendar_To_Excel_File)
End If
'Get object reference for Outlook Calendar folder
Set oOutlook_Calendar = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder( _
olFolderCalendar)
Set oCalendar_Items = oOutlook_Calendar.Items
'Loop Thru Each Items in Outlook Calendar
For Each oCalendarAppointment In oCalendar_Items
' here use start date and end date to limit the range
If Trim(Left(oCalendarAppointment.Start, InStr(1, oCalendarAppointment.Start, " "))) >= _
StartDate Then
If Trim(Left(oCalendarAppointment.Start, InStr(1, oCalendarAppointment.Start, " "))) _
Gruss
Dirk aus Dubai