Hello everyone.

I am rookie in VBA. I have an issue with Outlook macro. I want to move selected items from personal mailbox to sharedmailbox folders. It will works manually after clicking on button.

Macro will works for few users, and will also add details about user on the bottom of moved mail. The thing is how to "show" it in macro. Below is code with highlighted lines. I want to move mssgs to subfolder called "test". TIA for any help and suggestions/advices.

BTW without additional folder lvl it works OK.

Sub MakeDoneFlag()

'Get all selected items
Dim myItem As Outlook.MailItem 'selected mail
Dim myDestFolder As Outlook.Folder 'Destination Folder
Dim Sharedmailboxinbox As Outlook.Folder 'Sharedmailbox Inbox
Dim locbody 'body text
Dim objMsg As MailItem 'new email
Dim MyOlNamespace As Outlook.NameSpace
Dim myNameSpace As Outlook.NameSpace
Dim atinmia As Integer
Dim begtxt As Integer
Dim endtxt As Integer
Set MyOlNamespace = Application.GetNamespace("MAPI")
Set MyOlSelection = Application.ActiveExplorer.Selection
'
Set selItems = ActiveExplorer.Selection 'get selected items from InboX
Set myNameSpace = Application.GetNamespace("MAPI") 'get NamSpace
user = Session.CurrentUser.Name
useraddr = myNameSpace.Accounts.Item(1).DisplayName 'get the current user name
Set Sharedmailboxinbox = myNameSpace.Folders.Item("Shared_mailbox_name") 'get Shared_mailbox_name Inbox
On Error GoTo CreateFolder 'If the folder doesn't exist create it
Set myFolder = Sharedmailboxinbox.Folders("test").Item(user) 'get the current user folder

'Retrieve the selected item
For Each myItem In selItems
locbody = myItem.HTMLBody & " " & user & " " & Format(Date$, "yyyy-mm-dd") & " " & Time$ & " "
myItem.HTMLBody = locbody
myItem.Save
myItem.Move (myFolder)

Next
Exit Sub
CreateFolder:
Set myFolder = Sharedmailboxinbox.Folders("test").Add(user)
Resume Next