Question

我想将MailItems从一个Outlook文件夹复制到另一个Outlook文件夹。当我运行以下代码时，需要很长时间，即每个MailItem 5秒，即使MailItems只是几行的邮件＆lt; 5kB的。

我在IMAP电子邮件帐户的文件夹中执行此操作。

有时我也会收到一个错误，即项目无法移动但只能被复制。

我做错了什么？这应该很简单。

目前，代码首先在原始文件夹中创建邮件副本，然后移动此副本。我更喜欢直接在目标文件夹中创建一个副本。

如果我通过拖放邮件手动执行此操作（按住Ctrl键进行复制），这样可以快速完成，就像3个邮件的1s一样。

Sub CopyMailsToOtherFolder()
On Error GoTo CopyMailsToOtherFolder_Err
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")

    Dim TestFolder As Outlook.Folder
    Dim OutFolder As Outlook.Folder

    Dim objItem As Object   'Note that myItem is declared as type Object so that it can represent all types of Outlook items including meeting request and task request items.

    Dim MsgOrg As Outlook.MailItem
    Dim MsgCopy As Outlook.MailItem

    Dim lngI As Long

    Set TestFolder = objNS.Folders("Edgar").Folders("Inbox")
    Set OutFolder = objNS.Folders("Edgar").Folders("Inbox").Folders("TestOut")

    Debug.Print "Start: " & Time()
    'For lngI = 1 To TestFolder.Items.Count
    For lngI = 1 To 3
        Set objItem = TestFolder.Items(lngI)
        If TypeName(objItem) = "MailItem" Then
            Set MsgOrg = objItem
            Debug.Print " Org: " & MsgOrg.Subject
            Set MsgCopy = MsgOrg.Copy      'Creates copy in original folder
            MsgCopy.Move OutFolder
        End If
    Next

    Debug.Print "Done"

CopyMailsToOtherFolder_Exit:
    Debug.Print "Exit: " & Time()
    Exit Sub

CopyMailsToOtherFolder_Err:
    Debug.Print "Error " & Err.Number & " - " & Err.Description
    Resume CopyMailsToOtherFolder_Exit

End Sub

为什么在Outlook中复制MailItems需要这么长时间？

0 个答案: