在MS Outlook VBA中,为什么通过表格循环要比通过文件夹循环快五倍?

huangapple go评论77阅读模式
英文:

In MS Outlook VBA, why is looping through a table five times faster than looping through the folder?

问题

当我在包含 220 个项目的文件夹上运行以下代码时,如果sLoopThrough为"folder",则输出速度为每秒 34 行 Excel,通过 Excel 列 Z 中的时间戳测量(当bTimeIt为 true 时)。当sLoopThrough为"table"时,输出跳升到每秒 165 行。为什么表循环速度要快五倍?

如果我能加速文件夹循环,我更喜欢它,因为它可以提供更多信息。例如,在以下代码中,文件夹循环给我附件的数量,而表只能告诉我是否有附件。

Sub pOutlookEmailPropertiesToExcel(sExcelPath As String, sExcelFile As String, _
                                   sExcelSheet As String, bNewFile As Boolean, _
                                   oOutlookFolder As MAPIFolder, sLoopThru As String, bTimeIt As Boolean)

...

    Case "folder":
        For nCounter = 1 To oOutlookFolder.Items.Count
            Set oEmailItem = oOutlookFolder.Items.Item(nCounter)
            ' Dallimore tests oEmailItem.Class here, says it seems to avoid syncronisation errors.
            nRowNext = oExcelSheet.Cells(oExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
            On Error GoTo ExcelError
            oExcelSheet.Range("A" & nRowNext & ":X" & nRowNext).Value = _
                Array(oOutlookFolder.Name, , , nCounter, _
                      oEmailItem.EntryID, oEmailItem.MessageClass, _
                      oEmailItem.SenderName, oEmailItem.SenderEmailAddress, oEmailItem.SenderEmailType, _
                      oEmailItem.SentOnBehalfOfName, _
                      oEmailItem.To, oEmailItem.CC, oEmailItem.BCC, oEmailItem.Subject, _
                      oEmailItem.Size, oEmailItem.Attachments.Count, _
                      oEmailItem.SentOn, oEmailItem.ReceivedTime, oEmailItem.CreationTime, _
                      oEmailItem.LastModificationTime, oEmailItem.DeferredDeliveryTime, _
                      oEmailItem.ReminderTime, oEmailItem.ExpiryTime, oEmailItem.UnRead)
            On Error GoTo 0
            If (bTimeIt) Then oExcelSheet.Range("Z" & nRowNext).Value = Now()
        Next nCounter
    Case "table":
        nCounter = 0
        Do Until (oOutlookTable.EndOfTable)
            nCounter = nCounter + 1
            Set oTableRow = oOutlookTable.GetNextRow()
            nRowNext = oExcelSheet.Cells(oExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
            On Error GoTo ExcelError
            oExcelSheet.Range("A" & nRowNext & ":X" & nRowNext).Value = _
                Array(oOutlookFolder.Name, , , nCounter, _
                    oTableRow("EntryID"), oTableRow("MessageClass"), _
                    oTableRow("SenderName"), oTableRow("SenderEmailAddress"), oTableRow("SenderEmailType"), _
                    oTableRow("SentOnBehalfOfName"), _
                    oTableRow("To"), oTableRow("CC"), oTableRow("BCC"), oTableRow("Subject"), _
                    oTableRow("Size"), _
                    oTableRow("http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"), _
                    oTableRow("SentOn"), oTableRow("ReceivedTime"), oTableRow("CreationTime"), _
                    oTableRow("LastModificationTime"), oTableRow("DeferredDeliveryTime"), _
                    oTableRow("ReminderTime"), oTableRow("ExpiryTime"), oTableRow("Unread"))
            On Error GoTo 0
            If (bTimeIt) Then oExcelSheet.Range("Z" & nRowNext).Value = Now()
        Loop
End Select    ' sLoopThru
英文:

When I run the following code on a folder of 220 items, if sLoopThrough is "folder", it outputs 34 Excel rows per second, as measured by timestamps in Excel column Z when bTimeIt is true. When sLoopThrough is "table", the output jumps to 165 per second. Why is the table loop five times faster?

I would prefer the folder loop if I can speed it up because it can give me more information. For example, in the following code, the folder loop gives me the number of attachments, whereas the table can only tell me whether there are any attachments or not.

Sub pOutlookEmailPropertiesToExcel(sExcelPath As String, sExcelFile As String, _
sExcelSheet As String, bNewFile As Boolean, _
oOutlookFolder As MAPIFolder, sLoopThru As String, bTimeIt As Boolean)
' Output properties of e-mails in the given Outlook folder to Excel.
' sLoopThru = "folder" or "table"
' This code requires "Tools > References > Microsoft Excel ___ Object Library": Check.
' The workbook is opened in a new instance of Excel.
' The following line appears three times. It finds the last row with a value in column A,
'       then adds 1 to get number of the first empty row. This allows this routine to be called multiple
'       times to collect data on a series of folders (bNewFile false after first one).
'   nRowNext = oExcelSheet.Cells(oExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
' Adapted from example code at:
'   https://learn.microsoft.com/en-us/office/vba/api/outlook.folder.gettable
' and subs AnswerD(), AnswerF1(), AnswerF2(), and AnswerG() in SO answer by Tony Dallimore:
'   www.stackoverflow.com/questions/8697493/update-excel-sheet-based-on-outlook-mail/#8699250
Dim oExcelApp As Excel.Application, oExcelFile As Excel.Workbook, oExcelSheet As Excel.Worksheet, _
nRowNext As Long, _
oEmailItem As Object, nEmailItemClass As Integer, _
oOutlookTable As Outlook.Table, oTableRow As Outlook.Row, _
nCounter As Long
Set oExcelApp = Application.CreateObject("Excel.Application")
oExcelApp.Visible = True         ' Dallimore: "This slows your macro but helps during debugging."
If (bNewFile) Then
Set oExcelFile = oExcelApp.Workbooks.Add
Else
Set oExcelFile = oExcelApp.Workbooks.Open(sExcelPath & sExcelFile)
End If
Set oExcelSheet = oExcelFile.Sheets(sExcelSheet)
' ***** Set up table and its columns.
If sLoopThru = "table" And (oOutlookFolder.DefaultItemType = olMailItem) Then
Set oOutlookTable = oOutlookFolder.GetTable("[CreationTime] <> '0'")    ' This filter includes all.
With oOutlookTable.Columns
.Add ("SenderName"): .Add ("SenderEmailAddress"): .Add ("SenderEmailType"): .Add ("SentOnBehalfOfName")
.Add ("To"): .Add ("CC"): .Add ("BCC")
.Add ("Size"):
.Add ("http://schemas.microsoft.com/mapi/proptag/0x0E1B000B")    ' PR_HASATTACH
' .Add ("http://schemas.microsoft.com/mapi/proptag/0x0E13000D")    ' PR_MESSAGE_ATTACHMENTS
' This adds without error, but output of it is empty.
.Add ("SentOn"): .Add ("ReceivedTime")
.Add ("DeferredDeliveryTime"): .Add ("ReminderTime"): .Add ("ExpiryTime")
.Add ("Unread")
End With
End If    ' sLoopThru = "table"
' ***** Output Excel header rows.
oExcelSheet.Range("A1").Value = "Properties of e-mail items in Outlook folder"
oExcelSheet.Range("A3:Y3").Value = _
Array("Folder", "Subfolders", "Items", "Item", "EntryID", "MessageClass", _
"SenderName", "SenderEmailAddress", "SenderEmailType", "SentOnBehalfOfName", _
"To", "CC", "BCC", "Subject", "Size", "Attachments", _
"SentOn", "ReceivedTime", "CreationTime", "LastModificationTime", _
"DeferredDeliveryTime", "ReminderTime", "ExpiryTime", "Unread", "Error")
If (bTimeIt) Then oExcelSheet.Range("Z3").Value = "Timestamp"
' ***** Output data on folder.
nRowNext = oExcelSheet.Cells(oExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
oExcelSheet.Range("A" & nRowNext & ":C" & nRowNext).Value = _
Array(oOutlookFolder.Name, oOutlookFolder.Folders.Count, oOutlookFolder.Items.Count)
' ***** Loop through items and output properties to Excel.
If (oOutlookFolder.DefaultItemType = olMailItem) Then
Select Case sLoopThru
Case "folder":
For nCounter = 1 To oOutlookFolder.Items.Count
Set oEmailItem = oOutlookFolder.Items.Item(nCounter)
' Dallimore tests oEmailItem.Class here, says it seems to avoid syncronisation errors.
nRowNext = oExcelSheet.Cells(oExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
On Error GoTo ExcelError
oExcelSheet.Range("A" & nRowNext & ":X" & nRowNext).Value = _
Array(oOutlookFolder.Name, , , nCounter, _
oEmailItem.EntryID, oEmailItem.MessageClass, _
oEmailItem.SenderName, oEmailItem.SenderEmailAddress, oEmailItem.SenderEmailType, _
oEmailItem.SentOnBehalfOfName, _
oEmailItem.To, oEmailItem.CC, oEmailItem.BCC, oEmailItem.Subject, _
oEmailItem.Size, oEmailItem.Attachments.Count, _
oEmailItem.SentOn, oEmailItem.ReceivedTime, oEmailItem.CreationTime, _
oEmailItem.LastModificationTime, oEmailItem.DeferredDeliveryTime, _
oEmailItem.ReminderTime, oEmailItem.ExpiryTime, oEmailItem.UnRead)
On Error GoTo 0
If (bTimeIt) Then oExcelSheet.Range("Z" & nRowNext).Value = Now()
Next nCounter
Case "table":
nCounter = 0
Do Until (oOutlookTable.EndOfTable)
nCounter = nCounter + 1
Set oTableRow = oOutlookTable.GetNextRow()
nRowNext = oExcelSheet.Cells(oExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
On Error GoTo ExcelError
oExcelSheet.Range("A" & nRowNext & ":X" & nRowNext).Value = _
Array(oOutlookFolder.Name, , , nCounter, _
oTableRow("EntryID"), oTableRow("MessageClass"), _
oTableRow("SenderName"), oTableRow("SenderEmailAddress"), oTableRow("SenderEmailType"), _
oTableRow("SentOnBehalfOfName"), _
oTableRow("To"), oTableRow("CC"), oTableRow("BCC"), oTableRow("Subject"), _
oTableRow("Size"), _
oTableRow("http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"), _
oTableRow("SentOn"), oTableRow("ReceivedTime"), oTableRow("CreationTime"), _
oTableRow("LastModificationTime"), oTableRow("DeferredDeliveryTime"), _
oTableRow("ReminderTime"), oTableRow("ExpiryTime"), oTableRow("Unread"))
On Error GoTo 0
If (bTimeIt) Then oExcelSheet.Range("Z" & nRowNext).Value = Now()
Loop
End Select    ' sLoopThru
End If            ' oOutlookFolder.DefaultItemType = olMailItem
If (bNewFile) Then
oExcelFile.SaveAs (sExcelPath & sExcelFile)
Else
oExcelFile.Save
End If
oExcelFile.Close
oExcelApp.Quit           ' Dallimore's code does this only for bNewFile true.
Exit Sub
ExcelError:
oExcelSheet.Range("Y" & nRowNext).Value = "Error " & Err.Number & _
" (" & Err.Description & ") from " & Err.Source
Resume Next
End Sub     ' pOutlookEmailPropertiesToExcel()

答案1

得分: 1

使用表格 - 数据在一次调用中检索,而不是分别打开每个项目并逐个检索属性。

如果您想要附件的数量,请请求 EntryIDPR_HASATTACH(您已经这样做了)。如果 PR_HASATTACH 为 true,请使用 Namespace.GetItemFromID 打开该项目,并查询 MailItem.Attachments.Count

英文:

Do use tables - the data is retrieved in a single call instead of opening each item separately and retrieving one property at a time.

If you want the number of attachments, request EntryID and PR_HASATTACH (you already do that). If PR_HASATTACH is true, open the item by its entry id using Namespace.GetItemFromID and query MailItem.Attachments.Count.

答案2

得分: 1

Outlook的表格术语在本质上非常接近SQL表格。在缓存的Exchange配置文件中,您将处理本地存储(数据存储)。当然,这比只是在文件夹中迭代所有项目要快得多。但它也有它自己的缺点 - 表格中仅包含默认的属性/数据集。您可以添加/删除列,但要访问诸如附件之类的对象,您需要恢复Attachments或Attachment类的真实实例。您能做的最好的事情是获取一个布尔值,以确定项目是否存在任何附件。但要将数据导出到Excel工作簿中,Outlook表格正是您需要的。

如果遇到带附件的项目,您需要恢复Outlook对象,然后尝试访问附件。不幸的是,没有其他方法。

但如果您需要搜索带附件的项目,您可以考虑使用Items类的Find/FindNextRestrict方法。它们允许获取符合您的搜索条件的项目并仅对它们进行迭代。您可以在我为技术博客撰写的文章中详细了解这些方法:

英文:

The Outlook's table term is very close by its nature to SQL tables. In case of cached Exchange profiles you deal with a local storage (data store). Of course, it is much faster than just iterating over all items in the folder. But it has its own minuses - only the default set of properties/data is included in the table. You can add/remove columns, but to access objects such as attachments you need to recover the real instance of the Attachments or Attachment class. The best what you could do is to the get a boolean value whether any attachment exists for the item or not. But to export data into Excel workbooks Outlook tables is exactly what you need.

If you meet an item with an attached file you need to recover an Outlook object and then try to access the attachments. There is no other way around that unfortunately.

But if you need to search for items with attachments you may consider using the Find/FindNext or Restrict methods of the Items class. They allow getting items that correspond to your search criteria and iterate over them only. You can read more about these methods in the articles that I wrote for the technical blog:

huangapple
  • 本文由 发表于 2023年5月25日 01:25:56
  • 转载请务必保留本文链接:https://go.coder-hub.com/76326024.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定