Hi all,

I have been stressing over this for three days now and i just can't figure
it out;

I have a shared mailbox attached to my folder list in Outlook 2007 called
Solutions-AU.
I want to be able to select any email from this mailbox's inbox folder then
click a macro button which will create a task, attach the email as an
attachment to this task, as well as fill the task with the email body. This
task needs to go to a sub-task of the above mentioned mailbox, ie August-08.
The same macro needs to them move the email in question to a sibling folder
of the same mailbox (not an inbox subfolder).
I have managed to put together the below macro which only works fine for
items within my own mailbox (GabrielD) but the Task is created in my own Task
folder (can't get it to go into a sub-task) and the email gets moved only in
subfolders of my own Inbox. please please please help!!!

Thank You so much.


Public Sub CreateTaskFromItem()

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

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

Dim cntSelection As Integer
cntSelection = olExp.Selection.Count

For I = 1 To cntSelection
Set olItem = olExp.Selection.item(I)
olTask.Attachments.Add olItem
olTask.Body = olItem.Body
olTask.Subject = olItem.SenderName & " - " & olItem.Subject
Next

olTask.Display
'Set the due date for today
olTask.DueDate = Date
'Set the reminder for 4 hours from now
olTask.ReminderSet = True
olTask.ReminderTime = DateAdd("h", 4, 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

'Sub MoveSelectedMessagesToFolder()

On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders(".Archive")
'Assume this is a mail folder
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation,
"INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If

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

Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub