Copy emails from source folder if not existing in

2019-08-03 00:15发布

I'm using Visual Studio to build an addin to copy emails.

The condition is to check, according to SentOn/ReceivedTime, and copy only those emails from the source folder that do not exist in the destination folder.

I tried below code but its gives me an error 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条回答
爷、活的狠高调
2楼-- · 2019-08-03 00:31

There is a logic error in your nested loop - for each item in the destination folder you copy all non-matches from the source folder, even though those items may match other items in the destination folder.

Here's an approach (untested) which should work. It's in VBA: my VB.NET is not good and anyway you tagged with 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
查看更多
登录 后发表回答