Retrieve Outlook mails from Excel

[Kiran]

Hi,
I have a list of loans for which Reports are prepared and stored in the PST
folder. Now we need the attachments of these Reports to be stored in a
specified folder (C:\Documents and
Settings\sundarak\Desktop\OLAttachments).The number of loans range in 1000’s
and I need to filter these from PST at once. I have the list of loans in
Excel. Can I filter these loans at once?

Thanks
Kiran

 

[joel]

1) Where are the loan numbers or all you extracting all mail? If you are
extractingg only some of the loans how do you identify each e-mail (subject
line contain loan number)?
2) Is the PST data in your e-mail account or is it an archieve that needs to
be opened?
3) Which folder in you e-mail account is the loans?
4) How manuy attachments are in each e-mail?
5) Arre the attachments in word, excel or some other format?

 

[Kiran]

Hi Joel,

1. I have extracted the Loan Number from the subject line and that needs to
be compared with the data in excel sheet.
2. The Foreclosure Reports are archived in a pst folder present in a Server.
3. The Loan numbers are in excel sheet and not in any folder. The path of
that is C:\Loans.xls
4. The attachments are in pdf format.

I just need to know how to filter the mails in pst at once.

 

[joel]

I've done something like this before where I had to extact tables from
filtered e-mail messages. Becuase the tables were in HTML format I used an
internet explorere to get the tables which you don't need to do but included
the code.

To do the advance filtering like you would manualy in outlook you need to
have a simple class module. I've attached the code I used before below.The
filtering was done with this statement

strF = "urn:schemas:httpmail:" & _
"subject LIKE '%Lock%' AND" & _
"%today(urn:schemas:httpmail:datereceived)%"

I got the syntax for the above statement by recording a macro and then
performed the filtering manually.The took the recorded macro and used in my
macro below.


class module
----------------------------------------------------------------
Public blnSearchComp As Boolean
Public g_clsTest As Class1
Sub GetMail()

Const strS As String = "Inbox"
Dim strF As String
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Const ForReading = 1, ForWriting = 2, _
ForAppending = 3
Dim TBL As Object

TempPath = Environ("Temp")
FName = TempPath & "\OutlookTMP.HTML"


strF = "urn:schemas:httpmail:" & _
"subject LIKE '%Lock%' AND" & _
"%today(urn:schemas:httpmail:datereceived)%"


blnSearchComp = False
Set g_clsTest = New Class1
g_clsTest.AdvSearch strS, strF, sch


While blnSearchComp = False
DoEvents
Wend

Set rsts = sch.Results
If rsts.Count = 0 Then
MsgBox ("No messages found - Exiting Sub")
Exit Sub
End If
rsts.Sort "ReceivedTime", Descending:=True
Set LatestMess = rsts.Item(1)


Set fs = CreateObject("Scripting.FileSystemObject")
Set fout = fs.CreateTextFile _
(FName, True)
fout.Write LatestMess.HTMLBody
fout.Close

'desroy class object
Set g_clsTest = Nothing

'Set IEObj = GetObject(FName)
Set IE = CreateObject("INternetExplorer.Application")
IE.Application.Visible = True
URL = FName
IE.Navigate2 URL
Do While IE.readyState <> 4
DoEvents
Loop

Set TBL = IE.document.getelementsbytagname("Table")

'find Net and Gross
'Set statement below causes errors

Set TBLRows = TBL.Item(0).Rows


Set RowOne = TBLRows.Item(0)
Set RowTwo = TBLRows.Item(1)
For i = 0 To (RowOne.Children.Length - 1)
If UCase(RowOne.Children.Item(i).innertext) = "NET" Then
NetCol = i
End If
If UCase(RowOne.Children.Item(i).innertext) = "GROSS" Then
GrossCol = i
End If

Next i
Net = Val(RowTwo.Children.Item(NetCol).innertext)
Gross = Val(RowTwo.Children.Item(GrossCol).innertext)
Total = Net + Gross
ActiveCell.Value = Total

IE.Application.Quit
End Sub

Public WithEvents olApp As Outlook.Application
Private m_sch As Outlook.Search
Public Sub AdvSearch(MyScope As String, MyFilter As String, _
ByRef m_sch)
Set m_sch = olApp.AdvancedSearch(MyScope, MyFilter)
End Sub
Private Sub Class_Initialize()
Set Me.olApp = CreateObject("Outlook.Application")
Set myNamespace = Me.olApp.GetNamespace("MAPI")
Set myfolder = myNamespace.GetDefaultFolder(olFolderInbox)
End Sub
Private Sub Class_Terminate()
Set Me.olApp = Nothing
End Sub
Private Sub olApp_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
blnSearchComp = True
End Sub

regular module

 

[Joel]

I've done something like this before where I had to extact tables from
filtered e-mail messages. Becuase the tables were in HTML format I used an
internet explorere to get the tables which you don't need to do but included
the code.

To do the advance filtering like you would manualy in outlook you need to
have a simple class module. I've attached the code I used before below.The
filtering was done with this statement

strF = "urn:schemas:httpmail:" & _
"subject LIKE '%Lock%' AND" & _
"%today(urn:schemas:httpmail:datereceived)%"

I got the syntax for the above statement by recording a macro and then
performed the filtering manually.The took the recorded macro and used in my
macro below.


class module
----------------------------------------------------------------
Public blnSearchComp As Boolean
Public g_clsTest As Class1
Sub GetMail()

Const strS As String = "Inbox"
Dim strF As String
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Const ForReading = 1, ForWriting = 2, _
ForAppending = 3
Dim TBL As Object

TempPath = Environ("Temp")
FName = TempPath & "\OutlookTMP.HTML"


strF = "urn:schemas:httpmail:" & _
"subject LIKE '%Lock%' AND" & _
"%today(urn:schemas:httpmail:datereceived)%"


blnSearchComp = False
Set g_clsTest = New Class1
g_clsTest.AdvSearch strS, strF, sch


While blnSearchComp = False
DoEvents
Wend

Set rsts = sch.Results
If rsts.Count = 0 Then
MsgBox ("No messages found - Exiting Sub")
Exit Sub
End If
rsts.Sort "ReceivedTime", Descending:=True
Set LatestMess = rsts.Item(1)


Set fs = CreateObject("Scripting.FileSystemObject")
Set fout = fs.CreateTextFile _
(FName, True)
fout.Write LatestMess.HTMLBody
fout.Close

'desroy class object
Set g_clsTest = Nothing

'Set IEObj = GetObject(FName)
Set IE = CreateObject("INternetExplorer.Application")
IE.Application.Visible = True
URL = FName
IE.Navigate2 URL
Do While IE.readyState <> 4
DoEvents
Loop

Set TBL = IE.document.getelementsbytagname("Table")

'find Net and Gross
'Set statement below causes errors

Set TBLRows = TBL.Item(0).Rows


Set RowOne = TBLRows.Item(0)
Set RowTwo = TBLRows.Item(1)
For i = 0 To (RowOne.Children.Length - 1)
If UCase(RowOne.Children.Item(i).innertext) = "NET" Then
NetCol = i
End If
If UCase(RowOne.Children.Item(i).innertext) = "GROSS" Then
GrossCol = i
End If

Next i
Net = Val(RowTwo.Children.Item(NetCol).innertext)
Gross = Val(RowTwo.Children.Item(GrossCol).innertext)
Total = Net + Gross
ActiveCell.Value = Total

IE.Application.Quit
End Sub

Public WithEvents olApp As Outlook.Application
Private m_sch As Outlook.Search
Public Sub AdvSearch(MyScope As String, MyFilter As String, _
ByRef m_sch)
Set m_sch = olApp.AdvancedSearch(MyScope, MyFilter)
End Sub
Private Sub Class_Initialize()
Set Me.olApp = CreateObject("Outlook.Application")
Set myNamespace = Me.olApp.GetNamespace("MAPI")
Set myfolder = myNamespace.GetDefaultFolder(olFolderInbox)
End Sub
Private Sub Class_Terminate()
Set Me.olApp = Nothing
End Sub
Private Sub olApp_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
blnSearchComp = True
End Sub

regular module