Below is the code tha tI used with outlook. If you are using the find
feature in outlook you will need to use a class module as well as a regular
module. Hre is mboth sets of code. I wanted to filter the emails base on
the data. I also want to retrieve the body of the email which is an html
file. I had to put the data into a temporary file to get the body of the
email message.
Ron DeBruin has some tips on his webpage
http://www.rondebruin.nl/tips.htm
-----------------------------------------------------------
class module
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
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
