Hi
I want to extract some details from my Outlook calendar (subject and start and end dates). I have this code:
Public Function GetEvents()
Dim oOutlook As Outlook.Application
Set oOutlook = CreateObject("Outlook.Application")
Dim oNS As Outlook.NameSpace
Set oNS = oOutlook.GetNamespace("MAPI")
Dim oAppointments As Outlook.MAPIFolder
Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
'Apply a filter
Dim sFilter As String
StartDate = Format("01/01/" & Year(Date), ddmmyy)
EndDate = Format("31/12/" & Year(Date), ddmmyy)
sFilter = "[Start] > '" & StartDate & "'" & "AND [End] < '" & EndDate & "'"
Dim oFilterAppointments As Object
Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)
'Iterate through each appt in the calendar and add these to Table CalTemp
Dim oAppointmentItem As Object
Dim strSQL As String
Dim Abbr As String
Dim Sbjt As String
DoCmd.RunSQL "DELETE FROM CalTemp;" 'clear the table
For Each oAppointmentItem In oFilterAppointments
If InStr(oAppointmentItem.Subject, ":") < 1 Then
'do nothing if there's no ":"
Else
Abbr = Left(oAppointmentItem.Subject, InStr(oAppointmentItem.Subject, ":") - 1) 'finds the text before ":"
Sbjt = Mid(oAppointmentItem.Subject, InStr(oAppointmentItem.Subject, ":") + 1) ' finds the text after ":"
'add the event to the table "CalTemp"
strSQL = "INSERT INTO CalTemp VALUES ('" & Abbr & "', '" & Sbjt & "', '" & oAppointmentItem.Start & "', '" & oAppointmentItem.End & "' );"
DoCmd.RunSQL strSQL
End If
Next
End Function
The code runs OK, but when it comes to recurring entries it only picks up the first occurrence (ie the start date of the recurrence), even if this is outside the start filter limits. I would like to get all occurences for each day they appear within the current year.
Can anyone please suggest how to modify the code for this? Thanks
(PS, I'm just an entusiastic amateur, please be gentle
)
I want to extract some details from my Outlook calendar (subject and start and end dates). I have this code:
Public Function GetEvents()
Dim oOutlook As Outlook.Application
Set oOutlook = CreateObject("Outlook.Application")
Dim oNS As Outlook.NameSpace
Set oNS = oOutlook.GetNamespace("MAPI")
Dim oAppointments As Outlook.MAPIFolder
Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
'Apply a filter
Dim sFilter As String
StartDate = Format("01/01/" & Year(Date), ddmmyy)
EndDate = Format("31/12/" & Year(Date), ddmmyy)
sFilter = "[Start] > '" & StartDate & "'" & "AND [End] < '" & EndDate & "'"
Dim oFilterAppointments As Object
Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)
'Iterate through each appt in the calendar and add these to Table CalTemp
Dim oAppointmentItem As Object
Dim strSQL As String
Dim Abbr As String
Dim Sbjt As String
DoCmd.RunSQL "DELETE FROM CalTemp;" 'clear the table
For Each oAppointmentItem In oFilterAppointments
If InStr(oAppointmentItem.Subject, ":") < 1 Then
'do nothing if there's no ":"
Else
Abbr = Left(oAppointmentItem.Subject, InStr(oAppointmentItem.Subject, ":") - 1) 'finds the text before ":"
Sbjt = Mid(oAppointmentItem.Subject, InStr(oAppointmentItem.Subject, ":") + 1) ' finds the text after ":"
'add the event to the table "CalTemp"
strSQL = "INSERT INTO CalTemp VALUES ('" & Abbr & "', '" & Sbjt & "', '" & oAppointmentItem.Start & "', '" & oAppointmentItem.End & "' );"
DoCmd.RunSQL strSQL
End If
Next
End Function
The code runs OK, but when it comes to recurring entries it only picks up the first occurrence (ie the start date of the recurrence), even if this is outside the start filter limits. I would like to get all occurences for each day they appear within the current year.
Can anyone please suggest how to modify the code for this? Thanks
(PS, I'm just an entusiastic amateur, please be gentle
