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

有很多方法可以做到这一点。这取决于你在做什么和在哪里做。

看着你的代码看起来你已经没有了，但选项可能是：通过Dav或EWS点击服务器，使用Tables OOM或搜索文件夹（如果你使用的是更新版本的outlook），使用RDO或CDO就像你说的那样。按照你对CDO的想法，速度的方法是使用MapiTables对象。

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

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

马库斯

    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而不是开始

过滤Outlook约会

1 个答案: