Moving Saved Email to Outlook sub-folder

[Premanshu999]

Hi Team,

In our company we follow a process where in a team saves e-mails in a shared folder from where people from another team are supposed to pick and start processing. As a improvement idea I was looking for a macro which upon triggering can loop through all the saved e-mails in that folder and can save or bring them in a outlook sub-folder of the processor's inbox of this team.

I have tried and figured out a code from internet which can copy files from one folder to another (please see below) but could not get to modify it to save the .msg files in the outlook subfolder. This is doable manually so was thinking there should be a macro as well which can do it automatically.

Any help will be highly appreciated. Thank you in advance .

Sub Download_sub()
Application.EnableCancelKey = xlDisabled
'On Error Resume Next
On Error GoTo 0

Set fobj = CreateObject("Scripting.FileSystemObject") 'create the file system object

'copy the folder from shared folder into users download folder
    fobj.CopyFolder sht_Databases.Range("B21").Value & "\MailFiles" & _
    , sht_Databases.Range("B22").Value

Set fobj = Nothing 'release the variable
'On Error GoTo 0
End Sub

Regards,
Premanshu