move an email to specified folder then do a task creation

[azhumvee]

So I have 2 separate macros that generally do what I want them to when ran separately.. except for the EntryID issue that i'll explain next.. heres my scenario..

I want to be able to pick a message from my Inbox that is an "Action" item.. I want to be able to click a Macro button and have it:
Move to a pre-specified folder (see MoveToFiled code below)
then after it moves, (so as to get the "latest" entryID), creates a task like the 2nd part of the macro below (MoveSelectedMailtoTask)
Right now I don't even have the knowledge to combine these two macros as one action, and even if I did.. after Outlook moves the email to the prespecified folder, it loses "focus" on the mail so then it wouldn't create a task for the email that I want it to.. Hope this makes some sense.. Thx in advance for any input!



Sub MoveToFiled()
On Error Resume Next


Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem


Set ns = Application.GetNamespace("MAPI")


'Define path to the target folder
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Actions")


If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If


If moveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If


For Each objItem In Application.ActiveExplorer.Selection
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move moveToFolder
End If
End If
Next


Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing


End Sub





Sub MoveSelectedMailtoTask()
Dim objTask As Outlook.TaskItem
Dim objMail As Outlook.MailItem

Set objTask = Application.CreateItem(olTaskItem)

For Each objMail In Application.ActiveExplorer.Selection

With objTask
.Subject = objMail.Subject
.StartDate = objMail.ReceivedTime
.Body = vbCrLf & vbCrLf & "url:outlook:" & objMail.EntryID & vbCrLf + objMail.Body
objMail.SaveAs attPath & objMail.EntryID
objTask.Attachments.Add attPath & objMail.EntryID, olEmbeddeditem
Kill (attPath & objMail.EntryID)
.Display
End With
'objMail.Delete
Next
Set objTask = Nothing
Set objMail = Nothing
End Sub

[westconn1]

you can test if this works correctly for you

Sub MoveToFiled()
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Dim objTask As Outlook.TaskItem
Dim objMail As Outlook.MailItem

Set ns = Application.GetNamespace("MAPI")
'Define path to the target folder
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("test")
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
If moveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
'For Each objItem In
Set objItem = Application.ActiveExplorer.Selection(0)
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move moveToFolder
Else
MsgBox "wrong type of item"
Exit Sub
End If
End If
'Next
Set objTask = Application.CreateItem(olTaskItem)
'For Each objMail In Application.ActiveExplorer.Selection
With objTask
.subject = objItem.subject
.StartDate = objItem.ReceivedTime
.Body = vbCrLf & vbCrLf & "url:outlook:" & objItem.EntryID & vbCrLf + objItem.Body
objItem.SaveAs attPath & objItem.EntryID
objTask.Attachments.Add attPath & objItem.EntryID, olEmbeddeditem
Kill (attPath & objItem.EntryID)
.Display
End With
'objMail.Delete
'Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
Set objTask = Nothing
Set objMail = Nothing
End Sub

[azhumvee]

Thank you so much for taking a stab at it. Ok I made a test folder below the inbox and ran the macro on a mail.. got this error: Run-time error '440': Array index out of bounds.. when I debug it highlights this line:
Set objItem = Application.ActiveExplorer.Selection(0)




you can test if this works correctly for you

Sub MoveToFiled()
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Dim objTask As Outlook.TaskItem
Dim objMail As Outlook.MailItem

Set ns = Application.GetNamespace("MAPI")
'Define path to the target folder
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("test")
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
If moveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
'For Each objItem In
Set objItem = Application.ActiveExplorer.Selection(0)
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move moveToFolder
Else
MsgBox "wrong type of item"
Exit Sub
End If
End If
'Next
Set objTask = Application.CreateItem(olTaskItem)
'For Each objMail In Application.ActiveExplorer.Selection
With objTask
.subject = objItem.subject
.StartDate = objItem.ReceivedTime
.Body = vbCrLf & vbCrLf & "url:outlook:" & objItem.EntryID & vbCrLf + objItem.Body
objItem.SaveAs attPath & objItem.EntryID
objTask.Attachments.Add attPath & objItem.EntryID, olEmbeddeditem
Kill (attPath & objItem.EntryID)
.Display
End With
'objMail.Delete
'Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
Set objTask = Nothing
Set objMail = Nothing
End Sub

[westconn1]

oops, change index to 1

[azhumvee]

that took care of the index out of bounds! bummer, the outlook URL is still failing -"The operation failed". I think it's still using the EntryID of *before* the email moves to a different folder... any way around that?



oops, change index to 1

[westconn1]

bummer, the outlook URL is still failing -"The operation failed"i have no error with this line
i am not sure the url is correct as it is not clickable when displayed, but the embeddeditem opens when clicked

try stepping through the code and check in the locals window to find out why the entryID has a problem, afaik the entryID is not changed by moving the mailitem, testing confirms this