My query is , i have below vba code trying to extract the outlook contents of a Particular Date - but my issue is whenever i try to run this code all the emails irrespective of the my required dates are being extracted:-
Sub GetFromInbox()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Object
Dim i As Integer
Dim Dstr As Date
Dim itms As Outlook.Items
Dim filteredItms As Outlook.Items
On Error GoTo err
dStart = Application.InputBox("Enter you start date in MM/DD/YYYY")
If dStart = Empty Then
MsgBox "Start date cannot be empty, please run it again"
Exit Sub
End If
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.Application.ActiveExplorer.CurrentFolder
MsgBox Fldr
i = 2
Do
For Each olMail In Fldr.Items
If olMail.Subject = "Test - 153EN" Then
Sheet3.Range(Cells(2, 8), Cells(2, 100)).ClearContents
Sheet3.Cells(i, 1).Value = olMail.Subject
Sheet3.Cells(i, 2).Value = olMail.ReceivedTime
Sheet3.Cells(i, 3).Value = olMail.Sender
i = i + 1
End If
Next olMail
Loop Until (DateValue(olMail.ReceivedTime) = dStart)
err:
'Display the error message in Status bar
If err.Number > 0 Then
Application.StatusBar = err.Description
MsgBox "Err#" & err.Number & " " & err.Description
End If
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
I have noticed the following code:
Do
For Each olMail In Fldr.Items
If olMail.Subject = "Test - 153EN" Then
Sheet3.Range(Cells(2, 8), Cells(2, 100)).ClearContents
Sheet3.Cells(i, 1).Value = olMail.Subject
Sheet3.Cells(i, 2).Value = olMail.ReceivedTime
Sheet3.Cells(i, 3).Value = olMail.Sender
i = i + 1
End If
Next olMail
Loop Until (DateValue(olMail.ReceivedTime) = dStart)
The fact is that the Do loop is ignored and you iterate over all items in the folder using the following loop inside:
For Each olMail In Fldr.Items
You need to use the Find / FindNext or Restrict methods of the Items class instead. The following articles describe them in depth:
Remove the Do Loop and inside the For Loop and another outer If/then statement conditioned to your date specification:
For Each olMail In Fldr.Items
If (DateValue(olMail.ReceivedTime) = dStart) Then
If olMail.Subject = "Test - 153EN" Then
Sheet3.Range(Cells(2, 8), Cells(2, 100)).ClearContents
Sheet3.Cells(i, 1).Value = olMail.Subject
Sheet3.Cells(i, 2).Value = olMail.ReceivedTime
Sheet3.Cells(i, 3).Value = olMail.Sender
i = i + 1
End If
End If
Next olMail
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.