macro to open the mail and copy the data to excel
 

i need a macro to open the lastest (for that day) outlook mail in inbox which
has subject begins with Lock and in that mail there is a table with four
columns, the macro should go to column called as Net and add the
amount(amount is given below the heading) with next column called as Gross
(amount is given below the heading) and paste in excel active cell.

macro to open the mail and copy the data to excel
 

I'm about 3/4 of the way there. I'm tyring to learn Outlook features in VBA.
I got the latest message but trying to figure out how to read the body of
the message.

There are 3 things you need to do
1) To the VBA reference add Outlook object
VBA menu Tools - References - Microsoft Outlook 10.o Object Library - Check
box and press Add. Use the latest version that is on your computer.

2) You need to Insert (from Inset VBA menu) a Class Module to you VBA
project called Class1. I'm using AdvanceSearch which is looking at your
inbox and finding the messages received today with LOCK in the subject.
AdvanceSearch triggers an event that can only be recognized in a class
module. The Class module when an event occurs sets blnSearchComp TRUE and
trigger the DoEvent in the module code. Add this code to the 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



3) This code is the module code where all your programming can be written.
the code calls the Class1 modules to initialize the search. Add the code to
a regular Module (not a 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



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
rsts.Sort "ReceivedTime", Descending:=True
Set LastestMess = rsts.Item(1)


End Sub


"Ranjit kurian" wrote:

i need a macro to open the lastest (for that day) outlook mail in inbox which
has subject begins with Lock and in that mail there is a table with four
columns, the macro should go to column called as Net and add the
amount(amount is given below the heading) with next column called as Gross
(amount is given below the heading) and paste in excel active cell.

macro to open the mail and copy the data to excel
 

I finally got the macro to run. I had to copy the Body of the email message
to a HTML file and then read the file. My code was reading the file using a
word object and getting errors. I simply read the file Using an Internet
Explorer and the code works perfectly. You need to create in VBA a Class
Module and a regular Module and add the code below. You need to run GetMail
macro in the reuglar macro sheet.

The code creates a temperory file using you enviromental parameter TEMP.
On my PC the location is C:\Documents and Settings\Joel\Local Settings\Temp




code for Class1 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

code for 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



"Ranjit kurian" wrote:

i need a macro to open the lastest (for that day) outlook mail in inbox which
has subject begins with Lock and in that mail there is a table with four
columns, the macro should go to column called as Net and add the
amount(amount is given below the heading) with next column called as Gross
(amount is given below the heading) and paste in excel active cell.

macro to open the mail and copy the data to excel
 

Hi joel

Thanks,

Actually i got the idea how to do it below is my code, if possible give me
the code after the mail is displayed it should copy the body into new excel
workbook, and while copying the data it should copy it in the same way how we
copy manually to a excel.....

"Joel" wrote:

I finally got the macro to run. I had to copy the Body of the email message
to a HTML file and then read the file. My code was reading the file using a
word object and getting errors. I simply read the file Using an Internet
Explorer and the code works perfectly. You need to create in VBA a Class
Module and a regular Module and add the code below. You need to run GetMail
macro in the reuglar macro sheet.

The code creates a temperory file using you enviromental parameter TEMP.
On my PC the location is C:\Documents and Settings\Joel\Local Settings\Temp




code for Class1 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

code for 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



"Ranjit kurian" wrote:

i need a macro to open the lastest (for that day) outlook mail in inbox which
has subject begins with Lock and in that mail there is a table with four
columns, the macro should go to column called as Net and add the
amount(amount is given below the heading) with next column called as Gross
(amount is given below the heading) and paste in excel active cell.