Voting Response

J

Junoon

Hi All,

I have created a worksheet which has Transport Drop times in Header Row
(Row 1) from B1 to say Y1 like this:

Name 00:00 00:30 01:00 01:30 02:00.....
-----------------------------------------------------------------


In Column 1, i have a Header Label "Names" for getting names.

I have a .msg template form which has the above voting options.
Employees click on the voting options on the mail form & a voting
response mail is received in my Inbox Folder.

What i am trying to do is to get the Employee Names as well as the
chosen Drop time ( in the form of a "Yes" or "Y") for employees from
Mails sent thru MS Outlook, create a Process folder below Inbox folder
& transfer the processed voting
response mails to that folder.

The code works fine, if the received mails in Outlook are Voting
responses & if they are showing one after the other in th Inbox folder.

BUT, if there are other mails lying in between the voting response
mails, it tends to slow down the code & most of the time, some voting
response mails are not processed.

What i think is that code gets stuck on :

objMail.class=olMail....as it scans for all types of mails & not only
Voting response mails.

Is there a property exclusively for Voting response, so that the code
can scan only for voting response mails & transfer it to processed
folder.

************************************************************************
Sub DropTimes()
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim objMail As Outlook.MailItem, objItem As Object


'Dim objExcel As Excel.Application
Dim objWks As Excel.Worksheet
'Dim objWkb As Excel.Workbook
'Dim objTimeRange As Excel.Range, objRange As Excel.Range


Dim intX As Integer
Dim iRow
'On Error Resume Next
Set objNS = Outlook.Application.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 ' Here, i guess it should
check only for Voting response mails to fasten the scanning.

Set objMail = objItem
If objMail.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 = "yes"
End If
End If
End If
Set objMail = Nothing
Set objItem = Nothing
Next


Set objRange = Nothing
Set objTimeRange = Nothing
Set objMail = Nothing
Set objWkb = Nothing
Set objWks = Nothing
Set objExcel = Nothing
Set objNS = Nothing
Set objInbox = Nothing

End Sub

***************************************************************

PLEASE HELP ASAP!
 
M

Michael Bauer

Am 18 May 2006 18:03:03 -0700 schrieb Junoon:

You could, e.g., flag all processed e-mails as Unread=False and restrict the
items for those which are Unread=True.
 
J

Junoon

Hi Michael,

Just to let you know, i receive about 70-80 mails & most of them are
Unread, so that may evaluate to TRUE.

Is there any other way i can exclusively process only Voting response
mails using code?

PLEASE HELP ASAP!
 
M

Michael Bauer

Am 19 May 2006 13:00:49 -0700 schrieb Junoon:

Restrict for VotingResponse should also work - but on my machine it doesn´t.
Another method to process the items many times faster is to use CDO 1.21
instead of the Outlook Object Model.
 
M

Michael Bauer

Am 22 May 2006 12:06:10 -0700 schrieb Junoon:

Ok, then I think using the Redemption from www.dimastr.com is a better idea.
That library is much easier do use.

Instead of the Outlook.Items and MailItem use the Redemption.RDOItems and
RDOMail objects.

The logon in OL >= XP looks like this:

Dim Session as RDOSession
Set Session=CreateObject("Redemption.RDOSession")
Session.MapiObject=Application.Session.MapiObject

BTW: You might be sure, screaming again and again that you´re in hurry
doesn´t has a positive effect. No one here asks just for fun, but has to
solve important problems. And they all are as urgent as yours.
 
J

Junoon

Hi Michael,

The Below code for Voting works fine (but slow)... so i have thought a
solution, that is, if i change the Default folder (Inbox) to a folder
(Drop Times) made by me & setup a Rule in MS Outlook, so that all
voting response mails go into that folder, then how can i incorporate
that in the below code???

*********************************************
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)

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, 53).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

************************************************

Warm Regards,
 
M

Michael Bauer

Am 26 May 2006 16:08:14 -0700 schrieb Junoon:

If, e.g., your temporary folder (called "drop times"?) is a subfolder of the
Inbox then you get access to it by this way:

Dim tempFolder as Mapifolder
Set tempFolder=Application.Session.GetDefaultFolder(olFolderInbox)
Set tempFolder=tempFolder.Folders("drop times")
 
J

Junoon

Hi Michael,

Sorry for replying late. Was out of town for summer holidays with kids.

Here's the working code:

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


The Code works fine on the Excel sheet, but it scans only a few voting
response mails & then stops. I have run it several times to process all
the mails.

I found that since i am using FIND, it processes different mails only
once. I also checked the VBA Help section, & found that there is a
FINDNEXT also. But i donot know how to Loop thru & do a FINDNEXT for
objmail.

.....Somewhere here lies the solution, but i donot know where i am going
wrong.
....if i want to insert "Set objRange =
objTimeRange.Find(objMail.VotingResponse, , , xlWhole)" in between this
code, where do i insert it, so that it can scan all the voting mails in
the Drops Folder.


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

Rgds,

Junoon
 
M

Michael Bauer

Am 15 Jun 2006 05:07:58 -0700 schrieb Junoon:

Answered in "Find......FindNext", 6/15/2006
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Find......FindNext 3
Outlook Code Problem On Email Moves - Error -2147221233 2
Moving Calendar items to a folder 1
Code to move task from inbox to a task folder 3
How do I eliminate the "Enable Macro" selection? 16
How do I move a message to a folder after forwarding ? 6
For Each loop not getting all Email Items 3
Search for Email, then send as an attachment to another email 2

Top