Question

我在excel中有一个宏，可以从共享邮箱中的文件夹和子文件夹中删除30天以上的邮件。我有一个单独的子用于循环浏览每个子文件夹，还有一个单独的子用于删除每个子文件夹中的邮件

Private Sub deletemails(ByVal tgtfolder as outlook.mapifolder)
    set olitems = tgtfolder.items.restrict("[SentOn] <='" & (Date -30) & "'")
    filtercount = olitems.count

    If filtercount > 0 Then
        On Error Resume Next
        For i=filtercount To 1 Step -1
            olitems.item(i).Delete
        Next i
    End If
End Sub

要删除13000封邮件（大约15个子文件夹）需要30个小时，在此期间，我的浏览速度非常慢（无法阅读邮件或执行任何操作）。有时会弹出，例如“ Microsoft excel正在等待另一个ole操作完成”。现在，我在设置中设置了“忽略其他DDE操作”。

由于我没有提及代码，我的上一个帖子已删除。请帮我。需要更好的方法从共享邮箱中删除邮件

Answer 1

这几乎是使用Outlook对象模型可以做的最好的事情-做正确的事，避免循环浏览文件夹中的所有项目，但是OOM不允许您在一次调用中删除多个项目-扩展MAPI（ C ++或Delphi）允许。

如果您使用Redemption（任何语言）是一种选择，它会公开RDOItems。RemoveMultiple方法，该方法需要输入ID的数组。

Sub deletemails(tgtfolder)
    set App = CreateObject("Outlook.Application")
    set Session = CreateObject("Redemption.RDOSession")
    Session.MAPIOBJECT = App.Session.MAPIOBJECT
    set rFolder = Session.GetRDOObjectFromOutlookObject(tgtfolder)
    d = Date - 30
    'we need the standard SQL yyyy-mm-dd format 
    set rs = rFolder.items.MAPITable.ExecSQL("SELECT EntryID From Folder Where SentOn <='" & Year(d) & "-" & Right("0" & Month(d), 2) & "-" & Right("0" & Day(d), 2) & "'")
    dim entryIds()
    redim entryIds(rs.RecordCount)
    i = 0
    while not rs.EOF
      entryIds(i) = rs.Fields(0).Value
      rs.MoveNext
      i = i + 1
    wend
    rFolder.Items.RemoveMultiple(entryIds)
End Sub

您可能想制作App和Session全局变量，并只初始化一次。

从共享邮箱删除邮件非常慢

1 个答案: