How to convert email to task on an OPENED EMAIL, pls?

[StargateFan]

I have these 2 great macros from a long time ago:
*********************************************************************
Sub TASK_CreateTaskFromEmail_WITH_attachment()

Dim olTask As Outlook.TaskItem
'Using object rather than MailItem, so that it
'can handle posts, meeting requests, etc as well
Dim olItem As Object
Dim olExp As Outlook.Explorer
Dim fldCurrent As Outlook.MAPIFolder
Dim olApp As Outlook.Application

Set olApp = Outlook.CreateObject("Outlook.Application")
Set olTask = olApp.CreateItem(olTaskItem)
Set olExp = olApp.ActiveExplorer
Set fldCurrent = olExp.CurrentFolder

Dim cntSelection As Integer
cntSelection = olExp.Selection.Count

For i = 1 To cntSelection
Set olItem = olExp.Selection.Item(i)
'------------------------------------------
' SET MESSAGE AS AN ATTACHMENT:
olTask.Attachments.Add olItem
'------------------------------------------
' SUBJECT LINE:
' olTask.Subject = "Follow up on " & olItem.Subject ' original
subject line code
olTask.Subject = "" & olItem.Subject
'------------------------------------------
' DELETE ORIGINAL EMAIL AFTER CREATING A TASK FROM IT:
' olTask.body = oltask.body & vbcrlf & olitem.body ' what does
this line do???
'------------------------------------------
Next


olTask.Display
'------------------------------------------
' SET THE DUE DATE FOR TODAY:
' olTask.DueDate = Date
'------------------------------------------
' SET THE REMINDER TIME FOR 3 HOURS FROM NOW:
' olTask.ReminderSet = True ' this would enable the feature that
sets reminder time
' olTask.ReminderTime = DateAdd("h", 3, Now) ' "h", 3, Now
determines the 3 HOURS FROM NOW
'------------------------------------------

'Saving the task item, so that in case I close it, I won't lose
'the items which were deleted after being attached to the task
olTask.Save

End Sub
*********************************************************************
Sub TASK_CreateTaskFromEmail_with_NO_attachment()

Dim olTask As Outlook.TaskItem
'Using object rather than MailItem, so that it
'can handle posts, meeting requests, etc as well
Dim olItem As Object
Dim olExp As Outlook.Explorer
Dim fldCurrent As Outlook.MAPIFolder
Dim olApp As Outlook.Application

Set olApp = Outlook.CreateObject("Outlook.Application")
Set olTask = olApp.CreateItem(olTaskItem)
Set olExp = olApp.ActiveExplorer
Set fldCurrent = olExp.CurrentFolder

Dim cntSelection As Integer
cntSelection = olExp.Selection.Count

For i = 1 To cntSelection
Set olItem = olExp.Selection.Item(i)
'------------------------------------------
' SET MESSAGE AS AN ATTACHMENT:
' olTask.Attachments.Add olItem
'------------------------------------------
' olTask.Subject = "Follow up on " & olItem.Subject ' original
subject line code
olTask.Subject = "" & olItem.Subject
' olItem.Delete ' blank out this line. It DELETES THE ORIGINAL
EMAL, often not very desirable.
' olTask.body = oltask.body & vbcrlf & olitem.body ' what does
this line do???
Next

olTask.Display
'------------------------------------------
' SET THE DUE DATE FOR TODAY:
' olTask.DueDate = Date
'------------------------------------------
' SET THE REMINDER TIME FOR 3 HOURS FROM NOW:
' olTask.ReminderSet = True ' this would enable the feature that
sets reminder time
' olTask.ReminderTime = DateAdd("h", 3, Now) ' "h", 3, Now
determines the 3 HOURS FROM NOW
'------------------------------------------

'Saving the task item, so that in case I close it, I won't lose
'the items which were deleted after being attached to the task
olTask.Save

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

However, they only work on items that are closed. What I mean by that
is the email is just selected in your inbox, say, then you run the
macro. However, that isn't always convenient. Due to a freeware app,
I can set other folders to display alerts and I have one for special
reminders as I send myself reminders to work all the time. The OL2003
rules know to shunt those over to the special reminders folder yet the
tasks come up since all these emails have 0-day flags put on them
immediately in the rules. immiediatI have them set as flags to run
immediately in the rules. But at that point, when I open them to read
them is when I would like to run either macro to convert to a task.
But neither works on an opened message. Since they're no longer in
the inbox, it's a pain to either go chasing them down in the reminder
folder to then select them and then run the macro or while open to
have to do the manual click process to convert to task.

How can we convert an open email to a task, pls?

Thanks.

 

[StargateFan]

Does anyone know how to convert the macro here to work while the email
message is OPEN? Currently, it only works on closed, selected email
messages only.

Thanks.

 

[Michael Bednarek]

Does anyone know how to convert the macro here to work while the email
message is OPEN? Currently, it only works on closed, selected email
messages only.

Instead of
For i = 1 To cntSelection
Set olItem = olExp.Selection.Item(i)

try using
Application.ActiveInspector.CurrentItem

In detail:
* remove the loop "For i = 1 To cntSelection" and its "Next"
* instead of "Set olItem = olExp.Selection.Item(i)" use
"Set olItem=olApp.ActiveInspector.CurrentItem"
* the statements
Dim cntSelection As Integer
cntSelection = olExp.Selection.Count
are no longer needed
* (fldCurrent was and is unneeded, too)

Untested. Good luck.