Attribute VB_Name = "Module1"
Option Explicit
Dim strUID As String
Sub main()
    Call Create_Recur_Appt
    Call Recur_Expand
    Call Get_Instances
End Sub
Public Sub Create_Recur_Appt()
Dim oAppointment As New CDO.Appointment
Dim strURL As String

 With oAppointment
  .StartTime = #3/5/2001 1:00:00 PM#
  .EndTime = #3/5/2001 3:00:00 PM#
  .Subject = "Daily Meeting"
  .Location = "My Office"
  .TextBody = "Let us talk about something"
End With

With oAppointment.RecurrencePatterns.Add("Add")
   .Frequency = cdoDaily
   .Interval = 1
   .Instances = 5
End With

strURL = "file://./backofficestorage/ywd.extest.microsoft.com/mbx/user1/calendar"
oAppointment.DataSource.SaveToContainer strURL
strUID = oAppointment.Fields("urn:schemas:calendar:uid")

Set oAppointment = Nothing
End Sub
Public Sub Recur_Expand()
Dim oCon As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim strURL As String
Dim strSQL As String

strURL = "file://./backofficestorage/ywd.extest.microsoft.com/mbx/user1/calendar/"

With oCon
    .ConnectionString = strURL
    .Provider = "Exoledb.DataSource"
    .Open
End With

strSQL = "SELECT ""DAV:href"", ""urn:schemas:calendar:instancetype"" " & _
        "FROM SCOPE('shallow traversal of """ & strURL & """') " & _
        "WHERE (""urn:schemas:calendar:dtstart"" <= CAST(""2001-03-31T00:00:00Z"" as 'dateTime') " & _
        "AND ""urn:schemas:calendar:dtend"" >= CAST(""2001-03-01T00:00:00Z"" as 'dateTime'))"
Debug.Print strSQL

oRS.Open strSQL, oCon

Do Until oRS.EOF
    Debug.Print oRS.Fields("DAV:href").Value
    Debug.Print oRS.Fields("urn:schemas:calendar:instancetype").Value
    oRS.MoveNext
Loop

Set oCon = Nothing
Set oRS = Nothing
End Sub
Public Sub Get_Instances()
Dim oCon As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim strURL As String
Dim strSQL As String

strURL = "file://./backofficestorage/ywd.extest.microsoft.com/mbx/user1/calendar/"

With oCon
    .ConnectionString = strURL
    .Provider = "Exoledb.DataSource"
    .Open
End With

strSQL = "SELECT ""urn:schemas:calendar:dtstart"", ""urn:schemas:calendar:instancetype"" " & _
        "FROM SCOPE('shallow traversal of """ & strURL & """') " & _
        "WHERE (""urn:schemas:calendar:uid"" = '" & strUID & "')"
Debug.Print strSQL

oRS.Open strSQL, oCon

Do Until oRS.EOF
    Debug.Print oRS.Fields("urn:schemas:calendar:dtstart").Value
    Debug.Print oRS.Fields("urn:schemas:calendar:instancetype").Value
    oRS.MoveNext
Loop

Set oCon = Nothing
Set oRS = Nothing
End Sub
