使用Outlook 2016，我试图查找发送到或从特定电子邮件地址接收的最新电子邮件，并将其副本保存到特定文件夹。
我已经开发了一些代码，但是我认为我在排序和选择正确的受限项目时遇到问题。一旦按日期排序，代码就不会选择最新的电子邮件。如果多次运行代码，它将始终返回同一封电子邮件，但肯定不会返回最新的电子邮件。
下面是我创建的函数。希望有人能够提供帮助。预先感谢。
Sub Get_The_Emails(intTarget As Integer)
Dim oInboxFolder As Outlook.folder, oSentFolder As Outlook.folder
Dim tFolder As Outlook.folder, sFolder As Outlook.folder
Dim oNS As Outlook.NameSpace
Dim oInboxItems As Outlook.Items, oSentItems As Outlook.Items, colItems As Outlook.Items
Dim oFilteredInboxItems As Outlook.Items, oFilteredSentItems As Outlook.Items, oFilteredItems As Outlook.Items
Dim oReceivedItem As Outlook.MailItem, oSentItem As Outlook.MailItem, oItem As Outlook.MailItem
Dim strFolder As String
Dim strSentFilter As String, strReceivedFilter As String
Dim intFolder As Integer, intMode As Integer, intSource As Integer
Dim theReceivedTime As Date, theSentTime As Date
Dim inputFile As String
Dim inputNum As Integer, i As Integer
Dim strEnviro As String, strContent As String
Dim varList As Variant
strEnviro = CStr(Environ("USERPROFILE"))
inputFile = strEnviro & "\Desktop\Email-List.txt"
If Dir(inputFile, vbDirectory) = "" Then
MsgBox "File: " & inputFile & " could not be found", vbCritical, "Error"
Exit Sub
Else
CleanList inputFile
DoEvents
End If
inputNum = FreeFile
Open inputFile For Input As inputNum
strContent = Input(LOF(inputNum), inputNum)
Close inputNum
If Len(strContent) < 6 Then
MsgBox "Invalid email address list", vbCritical, "Error"
Exit Sub
Else
varList = Split(strContent, vbNewLine)
End If
Set oNS = Application.GetNamespace("MAPI")
Set oInboxFolder = oNS.Session.GetDefaultFolder(olFolderInbox)
Set oInboxItems = oInboxFolder.Items
Set oSentFolder = oNS.Session.GetDefaultFolder(olFolderSentMail)
Set oSentItems = oSentFolder.Items
intFolder = intTarget
Select Case intFolder
Case 1: strFolder = "1. Latest"
Case 2: strFolder = "2. Received"
Case 3: strFolder = "3. Sent"
End Select
On Error Resume Next
Set tFolder = oNS.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(strFolder)
If Err <> 0 Then
Err.Clear
Set tFolder = oNS.Session.GetDefaultFolder(olFolderInbox).Parent.Folders.Add(strFolder)
End If
On Error GoTo 0
intMode = intTarget
Select Case intFolder
Case 1: For i = LBound(varList) To UBound(varList)
strSentFilter = "@SQL=" & "urn:schemas:httpmail:displayto" & _
" Like '%" & CStr(varList(i)) & "%' Or " & _
"urn:schemas:httpmail:displaycc" & _
" Like '%" & CStr(varList(i)) & "%' Or " & _
"urn:schemas:httpmail:displaybcc" & _
" Like '%" & CStr(varList(i)) & "%'"
Set oFilteredInboxItems = oInboxItems.Restrict("[SenderEmailAddress] = '" & CStr(varList(i)) & "'")
With oFilteredInboxItems
If .Count > 0 Then
oFilteredInboxItems.Sort "[ReceivedTime]", True
theReceivedTime = oFilteredInboxItems(1).ReceivedTime
End If
End With
'Set oFilteredSentItems = oSentItems.Restrict("[To] = '" & CStr(varList(i)) & "'")
Set oFilteredSentItems = oSentItems.Restrict(strSentFilter)
With oFilteredSentItems
If .Count > 0 Then
oFilteredSentItems.Sort "[SentOn]", True
theSentTime = oFilteredSentItems(1).SentOn
End If
End With
If oFilteredInboxItems.Count > 0 And oFilteredSentItems.Count = 0 Then
Set oItem = oFilteredInboxItems(1)
End If
If oFilteredInboxItems.Count = 0 And oFilteredSentItems.Count > 0 Then
Set oItem = oFilteredSentItems(1)
End If
If oFilteredInboxItems.Count > 0 And oFilteredSentItems.Count > 0 Then
If theReceivedTime > theSentTime Then
Set oItem = oFilteredInboxItems(1)
Else
Set oItem = oFilteredSentItems(1)
End If
End If
oItem.Copy
oItem.Move tFolder
Debug.Print oFilteredInboxItems(1).Subject, theReceivedTime, oFilteredSentItems(1).Subject, theSentTime
Set oFilteredInboxItems = Nothing: Set oFilteredSentItems = Nothing: Set oFilteredItems = Nothing
Set oReceivedItem = Nothing: Set oSentItem = Nothing: Set oItem = Nothing
Next
Case 2: For i = LBound(varList) To UBound(varList)
Set oFilteredInboxItems = oInboxItems.Restrict("[SenderEmailAddress] = '" & CStr(varList(i)) & "'")
With oFilteredInboxItems
If .Count > 0 Then
oFilteredInboxItems.Sort "[ReceivedTime]", True
theReceivedTime = oFilteredInboxItems(1).ReceivedTime
Set oReceivedItem = oFilteredInboxItems(1).Copy
oReceivedItem.Move tFolder
Debug.Print CStr(varList(i)), oReceivedItem.Subject, theReceivedTime
End If
End With
Set oFilteredInboxItems = Nothing: Set oFilteredSentItems = Nothing: Set oFilteredItems = Nothing
Set oReceivedItem = Nothing: Set oSentItem = Nothing: Set oItem = Nothing
Next
Case 3: For i = LBound(varList) To UBound(varList)
strSentFilter = "@SQL=" & "urn:schemas:httpmail:displayto" & _
" Like '%" & CStr(varList(i)) & "%' Or " & _
"urn:schemas:httpmail:displaycc" & _
" Like '%" & CStr(varList(i)) & "%' Or " & _
"urn:schemas:httpmail:displaybcc" & _
" Like '%" & CStr(varList(i)) & "%'"
'Set oFilteredSentItems = oSentItems.Restrict("[To] = '" & CStr(varList(i)) & "'")
Set oFilteredSentItems = oSentItems.Restrict(strSentFilter)
With oFilteredSentItems
Debug.Print i, CStr(varList(i)), .Count
If .Count > 0 Then
oFilteredSentItems.Sort "[SentOn]", True
theSentTime = oFilteredSentItems(1).SentOn
Set oSentItem = oFilteredSentItems(1).Copy
oSentItem.Move tFolder
Debug.Print i, CStr(varList(i)), oSentItem.Subject, theSentTime
End If
End With
Set oFilteredInboxItems = Nothing: Set oFilteredSentItems = Nothing: Set oFilteredItems = Nothing
Set oReceivedItem = Nothing: Set oSentItem = Nothing: Set oItem = Nothing
Next
End Select
End Sub
绝对没有理由使用Restrict，因为您只想要返回的集合中的一项。首先对项目集合进行排序（Items.Sort），然后使用Items.Find查找匹配项。