如果目标文件夹中不存在,则从源文件夹复制电子邮件
Copy emails from source folder if not existing in destination folder
我正在使用 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
您的嵌套循环中存在逻辑错误 - 对于目标文件夹中的每个项目,您从源文件夹中复制了所有不匹配项,即使这些项目可能与目标文件夹中的其他项目匹配。
这是一种应该有效的方法(未经测试)。
它在 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
我正在使用 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
您的嵌套循环中存在逻辑错误 - 对于目标文件夹中的每个项目,您从源文件夹中复制了所有不匹配项,即使这些项目可能与目标文件夹中的其他项目匹配。
这是一种应该有效的方法(未经测试)。 它在 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