Sub ExportCalendar(olkFolder As Outlook.MAPIFolder, strFileName As String, datStart As Date, datEnd As Date)
Dim objFSO As Object, _
objFile As Object, _
olkItems As Outlook.Items, _
olkItem As Outlook.AppointmentItem, _
strBuffer As String, _
datMyStart As Date, _
datMyEnd As Date, _
qt As String
qt = Chr(34)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(strFileName, True)
Set olkItems = olkFolder.Items
olkItems.IncludeRecurrences = True
datMyStart = VBA.Format(datStart, "Short Date")
datMyEnd = VBA.Format(datEnd, "Short Date")
Set olkItem = olkItems.Find("[Start] >= """ & datMyStart & """ and [Start] <= """ & datMyEnd & """")
'Modify the header line to reflect all the values being written
While TypeName(olkItem) <> "Nothing"
'The first value has to be written with a command like this
strBuffer = qt & .Subject & qt & ","
'Each subsequent value has to be written with a line like this
strBuffer = strBuffer & qt & .Start & qt & ","
'The final value has to be written with a line like this
strBuffer = strBuffer & qt & .End & qt
strBuffer = ""
Set olkItem = olkItems.FindNext
Set objFile = Nothing
Set objFSO = Nothing
Set olkItem = Nothing
Set olkProp = Nothing
Open in new window
Please enter a first name
Please enter a last name
Must be at least 4 characters long.
Join and Comment
From novice to tech pro — start learning today.
Premium members can enroll in this course at no extra cost.
Premium members get this course for $159.20.
Premium members get this course for $349.00.
Premium members get this course for $49.99.
Premium members get this course for $167.20.
Premium members get this course for $95.20.
Premium members get this course for $37.50.