Hello,
How do you move these attached mailitem to one folder manually?
Do you open the attached mailitem and then go to File -> Info -> Move to Folder -> Copy to Folder ?
You could firstly search all items with attachments and then check if its attachment is a mail item, then save it into local and open it in Outlook, then you could copy the attached mailitem in a certain folder.
The code below could search inbox and save all attached msg file into subfolder of inbox.
Sub Demo()
Dim qry As String
Dim myInbox As Items
Dim myItems As Items
Dim myItem As Object
Dim myMailitem As MailItem
Dim att As Attachment
Dim path As String
Dim eml As MailItem
Dim myCopiedItem As MailItem
qry = "@SQL=" & Chr(34) & "urn:schemas:httpmail:hasattachment" & Chr(34) & "=1"
Set myInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Set myItems = myInbox.Restrict(qry)
For Each myItem In myItems
If TypeOf myItem Is Outlook.MailItem Then
Set myMailitem = myItem
For Each att In myMailitem.Attachments
If att.Type = olEmbeddeditem Then
path = "D:\test\" & att.FileName
att.SaveAsFile (path)
Set eml = Application.GetNamespace("MAPI").OpenSharedItem(path)
Set myCopiedItem = eml.Copy
myCopiedItem.Move Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("subfolder")
Kill path
End If
Next
End If
Next
End Sub
Regards,
Celeste
MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to
MSDN Support, feel free to contact MSDNFSF@microsoft.com.