C
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
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