Import MS Outlook Appointments Using a Date Criteria 2

[prover]

I can import all appointments from Outlook but what I'd like to do is only import appointments between a certain date period.

The following code imports all appointments.. is there a way to refine my criteria?

Dim ol As New Outlook.Application
   Dim olns As Outlook.NameSpace
   Dim cf As Outlook.MAPIFolder
   'Dim c As Outlook.ContactItem
   Dim c As Outlook.AppointmentItem
   Dim objItems As Outlook.Items
   Dim Prop As Outlook.UserProperty

   Set olns = ol.GetNamespace("MAPI")
   Set cf = olns.GetDefaultFolder(olFolderCalendar)
   Set objItems = cf.Items
   iNumContacts = objItems.Count
   If iNumContacts <> 0 Then
      For i = 1 To iNumContacts
         If TypeName(objItems(i)) = "AppointmentItem" Then
            Set c = objItems(i)
            'rst.AddNew
            'rst!FirstName = c.FirstName
            'rst!LastName = c.LastName
            'rst!Address = c.BusinessAddressStreet
            'rst!City = c.BusinessAddressCity
            'rst!State = c.BusinessAddressState
            'rst!Zip_Code = c.BusinessAddressPostalCode
            ' Custom Outlook properties would look like this:
            ' rst!AccessFieldName = c.UserProperties("OutlookPropertyName")
            
            rst.AddNew
            rst!Subject = c.Subject
            rst!Categories = c.Categories
            rst!Description = c.Body
            rst!StartDate = c.Start  ' Start Date and Start Time?
            rst!EndDate = c.End  'End Date and End Time?
            rst!Location = c.Location
            rst!StartTime = c.CreationTime
            rst!Alldayevent = c.Alldayevent
            rst!Sensitivity = c.Sensitivity
            
            rst.Update
         End If
      Next i
      rst.Close
      MsgBox "Finished."
   Else
      MsgBox "No appointments to export."
   End If

TIA

 

[PHV]

Something like this ?
...
If TypeName(objItems(i)) = "AppointmentItem" Then
Set c = objItems(i)
If c.Start < myEndDate And c.End > myStartDate Then
rst.AddNew
...
rst.Update
End If
End If
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Remou]

Note that the date is a string.

Set olRecItems = olNS.GetDefaultFolder(olFolderInbox)
strFilter = "[ReceivedTime] > " _
          & Chr(34) & Format(dteLastCheck, "mm/dd/yyyy hh:nn") & Chr(34) _
          & " AND [ReceivedTime] < " _
          & Chr(34) & Format(dteThisCheck, "mm/dd/yyyy hh:nn") & Chr(34)
Set olFilterRecItems = olRecItems.Items.Restrict(strFilter)

http://support.microsoft.com/kb/291161