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