Find......FindNext

[Junoon]

Hi,

I have a worksheet in which i extract email IDs from Outlook, of people
opting for a drop time.

I send out a voting response mail & the responses are collected into a
custom folder "DropTime" created below Inbox.

The code uses "Find" to search for Voting responses (in Subject)
formatted as text, like 0:30;1:00;1:30 etc...in the DropTime folder &
extracts the SenderName & puts them under the respective columns.


The Header columns in the Worksheet are the same text
0:00;0:30;1:00;1:30 etc....

A B C D E
F
0:00 0:30 1:00 1:30 2:00
2:30
-------------------------------------------------------------------------------

John Sam Masey Shirley
Fabian Dolly Manoj Raul
Gatsy
Hurley


etc,......

The only problem with the following code is that it only processes some
of the mails & not all (Dont know why). So i have to run the code again
& again to process them, which is tiresome as there are around 200-250
mails. I think i need to use FindNext to process the remaining mails,
but donot know how to get it in the loop.

========================
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 GetDropTimeVotes()

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).Folders("DropTime")

Set objWks = ThisWorkbook.Worksheets("Drops") '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, objRange.Column).Value =
objMail.SenderName
End If
Set FolderName = CreateInboxFolder(objInbox, "DropTime"
& "-" & 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
========================================


Is there a way to process them in one go......???

Rgds,

Junoon

 

[Michael Bauer]

Am 15 Jun 2006 13:24:51 -0700 schrieb Junoon:

Quite interesting, Junnon. You´re away for more than two weeks and now don´t
have the time to wait just one day for an answer. Two threads for the same
question forces us to answer twice - else we´d left one thread unanswered
for other people.

The answer to your question is the hot topic this week: if you remove an
item from a collection then all indizes after that item are concerned. Due
to that, a For Each or forward counting loop doesn´t work. Instead use a
backward counting loop, i.e. from Items.Count To 1 Step -1.

 

[Junoon]

Am 15 Jun 2006 13:24:51 -0700 schrieb Junoon:

Quite interesting, Junnon. You´re away for more than two weeks and now don´t
have the time to wait just one day for an answer. Two threads for the same
question forces us to answer twice - else we´d left one thread unanswered
for other people.

The answer to your question is the hot topic this week: if you remove an
item from a collection then all indizes after that item are concerned. Due
to that, a For Each or forward counting loop doesn´t work. Instead use a
backward counting loop, i.e. from Items.Count To 1 Step -1.

------------------------------------------------------------------


Hi Michael,


How would i incorporate a For Next..... Step -1 loop in the above
code....?

I have tried :

Set objItem = objMail
For objItem = objInbox.Items.Count To 1 Step -1..........

But does not seem to do anything...

Rgds,

junoon

 

[Junoon]

------------------------------------------------------------------


Hi Michael,


How would i incorporate a For Next..... Step -1 loop in the above
code....?

I have tried :

Set objItem = objMail
For objItem = objInbox.Items.Count To 1 Step -1..........

But does not seem to do anything...

Rgds,

junoon

=================================
Hi Michael,

Here's what i just now did & works. Found an old example from Sue
Mosher's post (2003). Thanks to her!

Thanks for your help!

-------------------------------------
Dim intCount as Integer

intCount = objInbox.Items.Count
For i = intCount To 1 Step -1
Set objItem = objInbox.Items(i)
If objItem.Class = olMail Then
Set objMail = objItem
..........Code.....