如果目标文件夹中不存在,则从源文件夹复制电子邮件

时间:2017-09-09 04:04:04

标签: vba visual-studio vsto outlook-addin

我使用Visual Studio构建插件来复制电子邮件。

条件是根据SentOn/ReceivedTime检查,并仅复制源文件夹中目标文件夹中不存在的那些电子邮件。

我尝试了下面的代码,但它给了我一个错误System.OutOfMemoryException Out of memory or system resources

Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
    Dim sMail As Object
    Dim dMail As Object
    Dim MailC As Object
    For Each sMail In SourceFolder.Items
        For Each dMail In DestinationFolder.Items
            If sMail.SentOn <> dMail.SentOn Then
                MailC = sMail.Copy
                MailC.Move(DestinationFolder)
            End If
        Next
    Next
End Sub

1 个答案:

答案 0 :(得分:1)

嵌套循环中存在逻辑错误 - 对于目标文件夹中的每个项目,您都会复制源文件夹中的所有不匹配项,即使这些项目可能与目标文件夹中的其他项目匹配。

这是一种应该有效的方法(未经测试)。 这是在VBA:我的VB.NET不好,无论如何你用VBA标记......

Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
    Dim sMail As Object
    Dim dMail As Object
    Dim MailC As Object
    Dim dictSent As New Scripting.dictionary, i As Long

    'get a list of all unique sent times in the
    '  destination folder
    For Each dMail In DestinationFolder.Items
        dictSent(dMail.SentOn) = True
    Next

    'loop through the source folder and copy all items where
    '  the sent time is not in the list
    For i = SourceFolder.Items.Count To 1 Step -1
        Set sMail = SourceFolder.Items(i)

        If Not dictSent.Exists(sMail.SentOn) Then
            Set MailC = sMail.Copy        'copy and move
            MailC.Move DestinationFolder
            dictSent(sMail.SentOn) = True 'add to list
        End If

    Next i

End Sub