Why does it take so long to copy MailItems in Outlook? - email

Question

I want to copy MailItems from one Outlook folder to another.
When I run the following code it takes a long time like i.e. 5 seconds per MailItem even if the MailItems are only mails with few lines < 5kB.
I do this in the folders of an IMAP EMail account.
Sometimes I also get an error that an item can not be moved but only be copied.
What do I do wrong? This should be simple.
Currently the code creates first a copy of the mail in the original folder and then I move this copy. I would prefer to create a copy directly in the destination folder.
If I do this manually by dragging and dropping the mails (holding Ctrl to make a copy) this works fast like maybe 1s for 3 mails.
Sub CopyMailsToOtherFolder()
On Error GoTo CopyMailsToOtherFolder_Err
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Dim TestFolder As Outlook.Folder
Dim OutFolder As Outlook.Folder
Dim objItem As Object 'Note that myItem is declared as type Object so that it can represent all types of Outlook items including meeting request and task request items.
Dim MsgOrg As Outlook.MailItem
Dim MsgCopy As Outlook.MailItem
Dim lngI As Long
Set TestFolder = objNS.Folders("Edgar").Folders("Inbox")
Set OutFolder = objNS.Folders("Edgar").Folders("Inbox").Folders("TestOut")
Debug.Print "Start: " & Time()
'For lngI = 1 To TestFolder.Items.Count
For lngI = 1 To 3
Set objItem = TestFolder.Items(lngI)
If TypeName(objItem) = "MailItem" Then
Set MsgOrg = objItem
Debug.Print " Org: " & MsgOrg.Subject
Set MsgCopy = MsgOrg.Copy 'Creates copy in original folder
MsgCopy.Move OutFolder
End If
Next
Debug.Print "Done"
CopyMailsToOtherFolder_Exit:
Debug.Print "Exit: " & Time()
Exit Sub
CopyMailsToOtherFolder_Err:
Debug.Print "Error " & Err.Number & " - " & Err.Description
Resume CopyMailsToOtherFolder_Exit
End Sub