Outlook VBA 如何在浏览文件夹列表时提高速度

Outlook VBA how to improve speed when looking thru a folders list

我目前正在编写一些代码,以便在我根据特定条件发送电子邮件时将其保存在特定文件夹中。我知道规则会做这样的事情,但请相信我,设置那么多规则将花费很长时间并且不切实际。所以这就是我想要做的。发送电子邮件时,代码会查看电子邮件的标题以查找项目编号。然后它会弹出一个用户表单,用户可以在其中根据需要进行多种归档选择。 它首先使用 VBA.SaveSetting 方法保存项目编号 然后 returns object "objX" 这实际上是正在发送的电子邮件 object。 所以在下面的代码中,我循环遍历 public 文件夹列表。文件夹名称的第一部分是项目编号。我要查找的项目编号保存在 "proj_folder" 局部变量中。
所以我循环遍历所有文件夹以查找以 "proj_folder" 变量开头的文件夹名称。 它工作正常,但如果有很多文件夹要循环通过,它会变得非常慢。 查看下面的代码,是否有人愿意分享一种提高循环速度的方法。现在循环遍历 30 个文件夹可能需要大约 2 秒。有时它可以达到 200 多个文件夹。

Sub MoveProject(objX)

Dim objNS As Outlook.NameSpace
Dim projectParentFolder As Outlook.MAPIFolder
Dim objFolder As Outlook.MAPIFolder
Dim proj_folder As String
Dim intX As Long

 'recall of the name of the folder saved from a previouly filed userform
proj_folder = VBA.GetSetting("mail filing", "num_projet", "num_proj", vbNullString)

sub_folder_1 = "Quebec"
sub_folder_2 = Left(proj_folder, 3)

Set objNS = Application.GetNamespace("MAPI")

Set projectParentFolder = objNS.Folders("Public Folder - UserAdress@server.com").Folders("All Public Folders").Folders(sub_folder1).Folders(sub_folder2)
'=============THIS IS THE PART WHERE I WOULD LIKE TO IMPROVE THE SPEED==============================
For intX = 1 To projectParentFolder.Folders.Count                   'searching for folder name beginning
    If Left(projectParentFolder.Folders.item(intX).Name, Len(proj_folder)) = proj_folder Then
        Set objFolder = projectParentFolder.Folders.item(intX)
        Exit For
    End If
Next
objX.Move objFolder                         'moving mail to objFolder

Set objX = Nothing
Set objFolder = Nothing
Set projectParentFolder = Nothing
Set objNS = Nothing

End Sub

循环中的点太多了。这是我的一般 VBA 速度 post。

设置属性或调用方法时,每一个都是CPU中的一个函数调用。这意味着堆栈设置开销。函数调用比内联代码慢。出于同样的原因,在 VBA 中使用循环而不是函数。

首先不要一遍又一遍地指定所有这些属性。除非你改变它们,否则它们不会改变。

With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False

    For loop to go through each word pair
        .Text = SrcText
        .Replacement.Text = DestText
        .Find.Execute Replace:=wdReplaceAll
    Next

End With

最小化点

因此,如果您对性能感兴趣,请尽量减少点(每个点都是一个查找),尤其是在循环中。

有两种方法。一种是如果要多次访问,将对象设置为最低的对象。

例如(较慢)

set xlapp = CreateObject("Excel.Application")
msgbox xlapp.worksheets(0).name 

(更快,因为每次使用该对象时都会省略一个点)

set xlapp = CreateObject("Excel.Application")
set wsheet = xlapp.worksheets(0)
msgbox wsheet.name

第二种方式是with。一次只能有一个处于活动状态。

这将跳过 100 次查找。

with wsheet
For x = 1 to 100
 msgbox .name
Next
end with

字符串连接

并且不要一次连接一个字符的字符串。从 VBScript 程序员那里看到这个。它需要 50,000 字节和许多分配和释放才能生成 100 个字符的字符串。

http://blogs.msdn.com/b/ericlippert/archive/2003/10/20/53248.aspx

读取属性

不要重新读取不会更改的属性,尤其是在进程外或后期绑定时。将它们放入变量中。与对象查找(这也是一个函数调用或至少两个,如果后期绑定)然后是函数调用相比,读取变量更快。

变量

编译后常量和文字几乎相同。

Const x = 5
msgbox x

相同
msgbox 5

直接在代码中插入文字。字符串和对象变量有管理器,会产生开销。避免无缘无故地创建变量。这是一个无意义的缓慢变量的例子。

x = "This is a string"
msgbox x

相比
const x = "This is a string"
msgbox x

msgbox "This is a string"

对象类型

这里有两个概念 - 进程内或进程外以及早期或晚期绑定。

exe文件连接到进程外。所有调用都通过 RPC(一种网络协议)进行编组。 Dll 文件正在处理中,函数调用直接跳转。

早期绑定是 set x = objecttype。编写程序时会查找函数。在执行时,程序被硬编码为跳转到存储在该函数的 vtable 中的地址。

已设置延迟绑定 x = createobject("objecttype")。每个函数调用都是这样的。 "Hi object do you have a print command"。 "Yes",它回复,"command number 3"。 "Hi object can you please do command number 3"。 "Sure, here's the result".

来自 Visual Basic 概念(帮助的一部分)

您可以通过优化 Visual Basic 解析对象引用的方式使您的 Visual Basic 应用程序 运行 更快。 Visual Basic 处理对象引用的速度受以下因素影响:

是否将 ActiveX 组件实现为进程内服务器或进程外服务器。

对象引用是早期绑定还是后期绑定。一般来说,如果一个组件已经作为可执行文件(.exe 文件)的一部分实现,那么它就是一个进程外服务器,并且 运行s 在它自己的进程中。如果它已作为动态-link 库实现,则它是一个进程内服务器并且 运行 与客户端应用程序在同一进程中。

使用进程内服务器的应用程序通常 运行 比使用进程外服务器的应用程序更快,因为应用程序不必跨越进程边界来使用对象的属性、方法和事件.有关进程内和进程外服务器的详细信息,请参阅 "In-Process and Out-of-Process Servers."

如果对象引用使用声明为特定 class 变量的对象变量,则它们是早期绑定的。如果对象引用使用声明为通用对象 class 变量的对象变量,则对象引用是后期绑定的。使用早期绑定变量的对象引用通常 运行 比使用后期绑定变量的对象引用更快。

Excel 具体

从 Microsoft 人员那里看到这个 link。这是 excel 特定的,而不是 VBA。 Autocalc 和其他计算 options/screenupdating 等

http://blogs.office.com/2009/03/12/excel-vba-performance-coding-best-practices/

.

编辑

我没有安装 Outlook,所以是这样的。

删除了圆点,更改为枚举 For Each,并将 len 函数移到了循环之外,这样它就不会被一遍又一遍地调用。

Set projectParentFolder = objNS.Folders("Public Folder - UserAdress@server.com").Folders("All Public Folders").Folders(sub_folder1).Folders(sub_folder2)

prog_folder_len = Len(Prog_Folder)

For Each Fldr in ProjectParentFolder.Folders
    If Left(Fldr.Name, prog_folder_len) = proj_folder Then
        Set objFolder = Fldr
        Exit For
    End If
Next

可以通过名称访问很多集合。

set objfolder = Fldr(Prog_Folder)set objfolder = Fldr.item(Prog_Folder) 之类的东西不起作用吗?

集合由对象实现。因此,如果不安装对象,就无法知道集合的功能。

For x = n to n 不同的是,For each 也是对象实现的,可能比 For x = n to n 更快。

对于消息,您可以使用 MAPIFolder.Items.Find/FindNext/RestrictMAPIFolder.GetTable 来使用自定义条件查找项目。不幸的是,Outlook 对象模型中的 MAPIFolder.Folders 集合没有这样的东西 - 假设子文件夹的数量总是很少。

您可以使用 Outlook 对象模型做的最好的事情是将子文件夹的全名传递给 Folders.Item() - 如果存在完全匹配(不区分大小写),MAPIFolder.Folders.Item() 将能够return 它没有遍历所有子文件夹。

如果您需要子字符串(或任何其他)匹配,您可以切换到扩展 MAPI(仅限 C++ 或 Delphi,而不是 VBA 中的选项)并使用 MAPIFolder.Folders.RawTable 检索 IMAPITable MAPI interface that you can use to search for a subfolder. Or you can use Redemption (I am its author) and its MAPITable 对象。您的代码如下所示:

set Table = CreateObject("Redemption.MAPITable")
Table.Item = projectParentFolder.Folders
Set Recordset = Table.ExecSQL("SELECT EntryID from Folder where Name like '" & proj_folder & "%' ")
If not Recordset.EOF Then
  strEntryID = Recordset.Fields(0).Value
  set objFolder = Application.Session.GetFolderFromID(strEntryID)
end If

文件夹对象 (RDOFolder) 的赎回版本还公开了 Folders.Find/FindNextFolders.Restrict 方法(类似于 Outlook 中的 Items 集合公开的方法)允许指定任意搜索子句:

set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set Folder = Session.GetFolderFromID(Application.ActiveExplorer.CurrentFolder.EntryID)
set subFolder = Folder.Folders.Find("Name LIKE 'MAPI%'")
if subFolder Is Nothing Then
  MsgBox "No such subfolder"
else
  MsgBox "Found subfolder named '" & subFolder.Name & "'"
end if