Outlook calendar export VBA with range period

Flaw98

New Member
Joined
Apr 10, 2019
Messages
2
Hello guys,

I am trying to modify a code that I found in order to export my calendar appointments in Excel. I need to export "Subject", "StartDate", "EndDate" and "Category". The main issue is that I want on a specific period of time by an Input Box, first to enter the start date and then the end date of the period I want to be exported. Also, there may be some recurrent activities weekly/monthly that should be exported correctly.

This is the code, but I cannot manage to modify it correctly.

Sub ListAppointments()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date


FromDate = CDate("04/01/2019")
ToDate = CDate("04/12/2019")


On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0


Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
NextRow = 2


With Sheets("Sheet1") 'Change the name of the sheet here
.Range("A1:D1").Value = Array("Subject", "StartDate", "EndDate", "Category")
For Each olApt In olFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
.Cells(NextRow, "A").Value = olApt.Subject
.Cells(NextRow, "B").Value = CDate(olApt.Start)
.Cells(NextRow, "C").Value = olApt.End - olApt.Start
.Cells(NextRow, "C").NumberFormat = "HH:MM:SS"
.Cells(NextRow, "D").Value = olApt.Location
.Cells(NextRow, "E").Value = olApt.Categories
NextRow = NextRow + 1
Else
End If
Next olApt
.Columns.AutoFit
End With


Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub

Thank you very much for your attention!
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,189
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top