To do any parsing of the message body would require careful use of string
manipulations functions (InStr, Left, Right, Mid, etc.).

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/


"Junoon" wrote:

Hi Eric,

This is What i have made....
************************************
Function CreateInboxFolder(oInbox, Fldr) As Object

Dim oFold As Object

'Look for archive folder and create if doesn't exist, create it
On Error Resume Next 'ignore error
Set oFold = oInbox.Folders(Fldr)
If Err.Number 0 Then Err.Clear

If oFold Is Nothing Then
Set oFold = oInbox.Folders.Add(Fldr, olFolderInbox)
End If

Set CreateInboxFolder = oFold

End Function
Function GetOutlook() As Object

Dim olApp As Object

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not running: please open the application first"
End If

Set GetOutlook = olApp

End Function

Sub CollectVotes()

Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim objMail As Outlook.MailItem
Dim objItem As Object
Dim olApp As Outlook.Application

If olApp Is Nothing Then
Set olApp = GetOutlook()
End If


Dim objWks As Excel.Worksheet
Dim objTimeRange As Excel.Range, objRange As Excel.Range
Dim iRow
Dim FolderName As Object

On Error Resume Next
Set objNS = olApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objWks = ThisWorkbook.Worksheets(ActiveSheet.Name) 'Use default
Sheet1
With objWks
iRow = objWks.Cells(objWks.Rows.Count, 1).End(xlUp).Row + 1
End With

Set objTimeRange = objWks.UsedRange

For Each objItem In objInbox.Items
If objItem.Class = olMail Then
Set objMail = objItem
If objItem.VotingResponse "" Then
Set objRange =
objTimeRange.Find(objMail.VotingResponse, , , xlWhole)
If Not objRange Is Nothing Then
objWks.Cells(iRow, 1).Value =
objMail.SenderName
objWks.Cells(iRow, objRange.Column).Value = "Y"
objWks.Cells(iRow, 50).Value =
Trim(objMail.Body)
End If
Set FolderName = CreateInboxFolder(objInbox, "Votes" &
"-" & Date)
objMail.Move FolderName
iRow = iRow + 1
End If
End If
Next

Set objItem = Nothing
Set objRange = Nothing
Set objTimeRange = Nothing
Set objMail = Nothing
Set objWks = Nothing
Set objExcel = Nothing
Set objNS = Nothing
Set objInbox = Nothing
Set olApp = Nothing

End Sub
**********************************

But if you look at the above code, ......objWks.Cells(iRow, 50).Value =
Trim(objMail.Body) is "Location" Column, & i want to just get the
Location from the Body of the mail.

The Body of the Voting Mail would be having 3 entries each on a line:
Location:
EmpID:
Shift Time:

1] If i make extra Columns after last time column (23:30) for the Shift
time, for each of the above parameters, viz., Location, EmpID, Shift
Time......How do i extract their data from the Body of the
Messages......

2] Also, if instead i have a Column of names in the 1st column & i am
not dumping any sender Names using code, how do i compare the names in
1st column & just have a "Y" reflecting under their chosen
time......Comparison would be faster.....
I just have an idea, that i would be able to extract the data using
Compare or Instr function.......

Please give me an example as i am really stuck at the last moment......


PLEASE HELP!

Cheers!