Getting outlook for the last week

[Coruba67]

Hello all! Was wondering how I can go about getting all the email out of
outlook for the past 7 days. I have done this, though it takes a long long
time and eventually all my memory gets taken up and the system stops
responding... any idea's? Thanks for your help!

Dim outlookApp As New Outlook.Application
Dim objOLApp As Outlook.Application
Dim objFolder As Outlook.MAPIFolder
Dim objExplorer As Outlook.Explorer
Dim objSubFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim objOutlookFolders As Outlook.Folders
Dim intFolderCtr As Integer
Dim intSubFolderCtr As Integer
Dim intMailCtr As Integer
Dim EmailFrom As String
Dim MailRecievedTime As DateTime
Dim count As Integer = 0

EmailFrom = "11/18/2008"

objOLApp = New Outlook.Application
objOutlookFolders = objOLApp.Session.Folders

' >> Loop Through The PST Files Added n Outlook
Try


For intFolderCtr = 1 To objOutlookFolders.Count
objFolder = objOutlookFolders.Item(intFolderCtr)
objExplorer = objFolder.GetExplorer()

' >> Loop Through The Folders In The PST File
For intSubFolderCtr = 1 To
objExplorer.CurrentFolder.Folders.Count
objSubFolder =
objExplorer.CurrentFolder.Folders.Item(intSubFolderCtr)

' >> Check if Folder Contains Appointment Items
If objSubFolder.DefaultItemType =
Outlook.OlItemType.olMailItem Then

' >> Loop Through Appointment Items
For intMailCtr = 1 To objSubFolder.Items.Count

' >> Get The Calender Item From The Calender
Folder
objMailItem = objSubFolder.Items.Item(intMailCtr)

' >> Process Appointment Item Accordingly
MailRecievedTime = objMailItem.ReceivedTime
If MailRecievedTime >= EmailFrom Then
count += 1
MsgBox("found one")
End If
Next
End If
Next
Next
Catch ex As Exception

End Try
If count = 0 Then
MsgBox("Did not find any emails within the last 7 days")
End If

' >> Close Application
'Call objOLApp.Quit()

' >> Release COM Object
Call System.Runtime.InteropServices.Marshal.ReleaseComObject(objOLApp)

objOLApp = Nothing

 

[Coruba67]

Have also tried this, but I don't know how to change the filtering criteria

Const PropTag As String = "http://schemas.microsoft.com/mapi/proptag/"
strFilter = "@SQL=" & Chr(34) & PropTag & "0x0037001E" & Chr(34) & "
ci_phrasematch 'Test'"


to only search through the last few days as oposed to through the subject line


Public Shared Sub SearchInbox()
Dim oT As Outlook.Table
Dim strFilter As String
Dim oRow As Outlook.Row

Dim myOlApp As Application
myOlApp = CreateObject("Outlook.Application")


'Construct filter for Subject containing 'Test'

Const PropTag As String = "http://schemas.microsoft.com/mapi/proptag/"
strFilter = "@SQL=" & Chr(34) & PropTag & "0x0037001E" & Chr(34) & "
ci_phrasematch 'Test'"

'Do search and obtain Table on Inbox
oT =
myOlApp.Session.GetDefaultFolder(OlDefaultFolders.olFolderInbox).GetTable(strFilter)

'Print Subject of each returned item
Do Until oT.EndOfTable
oRow = oT.GetNextRow
Debug.Print(oRow("Subject"))
MsgBox(oRow("Subject"))
Loop
End Sub

 

[Ken Slovak - [MVP - Outlook]]

The search you show is for the Subject of an item having "Test". If you want
to get items received within the last seven days you could use something
like this as your filter:

Dim datWeekAgo As DateTime = System.DateTime.Now().AddDays(-7)

Dim sWeekAgo As String = datWeekAgo.ToString("ddddd hh:mm t", _
CultureInfo.InvariantCulture)

Dim sFilter As String = "[ReceivedTime] >= '" + sWeekAgo + "'"

In addition to filtering the items so you have to iterate fewer of them
there are other things you should do to minimize the resource usage. In your
loops set your objects to Nothing so each object is released and you don't
create a ton of objects that won't go out of scope until the end of the
procedure. You might even have to call Marshal.ReleaseComObject() on each
pass through the loop to fully release the items.

 

[Coruba67]

That made heaps of sense, thanks for that - she's all up and running now!

The search you show is for the Subject of an item having "Test". If you want
to get items received within the last seven days you could use something
like this as your filter:

Dim datWeekAgo As DateTime = System.DateTime.Now().AddDays(-7)

Dim sWeekAgo As String = datWeekAgo.ToString("ddddd hh:mm t", _
CultureInfo.InvariantCulture)

Dim sFilter As String = "[ReceivedTime] >= '" + sWeekAgo + "'"

In addition to filtering the items so you have to iterate fewer of them
there are other things you should do to minimize the resource usage. In your
loops set your objects to Nothing so each object is released and you don't
create a ton of objects that won't go out of scope until the end of the
procedure. You might even have to call Marshal.ReleaseComObject() on each
pass through the loop to fully release the items.

Have also tried this, but I don't know how to change the filtering
criteria

Const PropTag As String = "http://schemas.microsoft.com/mapi/proptag/"
strFilter = "@SQL=" & Chr(34) & PropTag & "0x0037001E" & Chr(34) & "
ci_phrasematch 'Test'"


to only search through the last few days as oposed to through the subject
line


Public Shared Sub SearchInbox()
Dim oT As Outlook.Table
Dim strFilter As String
Dim oRow As Outlook.Row

Dim myOlApp As Application
myOlApp = CreateObject("Outlook.Application")


'Construct filter for Subject containing 'Test'

Const PropTag As String =
"http://schemas.microsoft.com/mapi/proptag/"
strFilter = "@SQL=" & Chr(34) & PropTag & "0x0037001E" & Chr(34) &
"
ci_phrasematch 'Test'"

'Do search and obtain Table on Inbox
oT =
myOlApp.Session.GetDefaultFolder(OlDefaultFolders.olFolderInbox).GetTable(strFilter)

'Print Subject of each returned item
Do Until oT.EndOfTable
oRow = oT.GetNextRow
Debug.Print(oRow("Subject"))
MsgBox(oRow("Subject"))
Loop
End Sub