筛选 Outlook 约会

Question

我在公用文件夹中有一个日历 在几年的时间里，日历中大约有 15000 次约会 我已经使用 OutlookSpy 来获取日历的 EntryId 使用 Outlook 编程书中的示例

Private Sub GetAppointmentsForDate(dteDate As Date)

Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colCal As Outlook.Items
Dim strFind As String
Dim colMyAppts As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Set objApp = CreateObject("Outlook.Application")
Set objNS = Application.GetNamespace("MAPI")

Set colCal = objNS.GetFolderFromID("{the Entry ID from OutlookSpy}").Items

colCal.Sort "[Start]"
colCal.IncludeRecurrences = True

Set colMyAppts = Nothing

strFind = "[Start] >= " & DoubleQuote(Format(dteDate, "dd mmm yyyy") & " 12:00 AM") & " AND [Start] < " & DoubleQuote(Format(dteDate + 1, "dd mmm yyyy") & " 12:00 AM")

Set colMyAppts = colCal.Restrict(strFind)
For Each objAppt In colMyAppts
Debug.Print objAppt.Start & vbTab & objAppt.Subject
Next
'clean up the objects used here
End Sub

我希望能够直接使用 MAPI 执行此操作 (CDO 1.21) 过滤有时最多需要 2 分钟，我希望将其缩短到几秒钟。

如果有人对示例代码有任何想法或改进，我将不胜感激。 [欢迎任何风格的 VB]

Answer 1

有很多方法可以做到这一点。这取决于您在做什么以及在哪里执行此操作。

查看您的代码，您似乎已退出 proc，但选项可能是：通过 Dav 或 EWS 访问服务器，使用 Tables OOM 或搜索文件夹（如果您使用更高版本的 Outlook），使用 RDO 或正如你所说的 CDO 等等。按照你对 CDO 的想法，快速完成它的方法是使用 MapiTables 对象。

我会使用 RDO 而不是 CDO，因为它有一个很好的辅助方法，它成本低但非常有用 http://www.dimastr.com/redemption/（它是由同一个人制作的。）

这段代码是我脑子里写的，所以可能需要一些更正，但它会让你走上正确的轨道。如果您提供有关版本和运行位置的更多详细信息，也许我可以添加更多。

马库斯

    Dim objRDOSession As Redemption.RDOSession
    Dim objCalRDOFolder As Redemption.RDOFolder
    Dim objMapiTable As Redemption.MapiTable
    Dim objRecordset As Recordset
    Set objRDOSession = CreateObject("Redemption.RDOSession")
    objRDOSession.Logon
    Set objCalRDOFolder = objRDOSession.GetFolderFromPath("<folder path>")
    'Set oCalFolder = objRDOSession.GetFolderFromID("<entry id>")'
   Set objMapiTable = CreateObject("Redemption.MAPITable")
    objMapiTable.Item = objCalRDOFolder.Items
   Set objRecordset = objMapiTable.ExecSQL("SELECT Subject, Start from Folder where  Start >='2008-06-10'  and Start < '2009-06-10'")
        While Not objRecordset.EOF
            Debug.Print (objRecordset.Fields("Start").Value & ":" & objRecordset.Fields("Subject").Value)
        Recordset.MoveNext
    Wend
' clean up etc

更新：尝试http://schemas.microsoft.com/mapi/proptag/0x001A001E而不是开始