Mess with moving by macro and deleting mails in MS Outlook 2013

[Lathelus]

I've got a problem. I want to make a macro for Outlook 2013, which would move selected mail to several folders, 2 folders on the same account, and to inbox of another one (and make these folders, if needed). I've made up a working script, it does exactly what I want, but there is a weird problem. When I delete a mail in one of the 2 folders in source account, it disappears in the second folder (in trash is only one mail). One in another account stays untouched. But when I move that mail back to inbox of source account, now that deleted mail in trash disappears! I ask you, what is going on? Do you also have such problems? Here is my code (addresses changed):


Sub TEST()
Dim objMail As MailItem
Set objMail = GetCurrentItem()
If Not objMail Is Nothing Then
MoveMail objMail
objMail.Delete
Exit Sub
Else
MsgBox "Please select message", vbCritical
End If
End Sub


Private Sub MoveMail(ByVal objMail As MailItem)
Dim copiedMail As MailItem
Dim copiedMail2 As MailItem
Dim copiedMail3 As MailItem
Dim TestFolder As Folder
Dim HelpDeskFolder As Folder
Dim MainFolder As Folder


On Error GoTo MoveMail_Error
Set MainFolder = GetFolder("Inbox", "emailadress2")
If Not MainFolder Is Nothing Then
Set copiedMail = objMail.Copy
copiedMail.UnRead = True
copiedMail.Move MainFolder
End If
Set TestFolder = GetFolder("Test", "emailadress1")
If Not TestFolder Is Nothing Then
Set copiedMail2 = objMail.Copy
copiedMail2.UnRead = False
copiedMail2.Move TestFolder
Set copiedMail2 = Nothing
End If
Set HelpDeskFolder = GetFolder("Help desk", "emailadress1")
If Not HelpDeskFolder Is Nothing Then
Set copiedMail3 = objMail.Copy
copiedMail3.UnRead = False
copiedMail3.Move HelpDeskFolder
Set copiedMail3 = Nothing
End If
objMail.Delete
Exit Sub
MoveMail_Error:
MsgBox "Copying error", vbCritical
End Sub




Private Function GetCurrentItem() As MailItem
Dim objApp As Outlook.Application


Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select


Set objApp = Nothing
End Function


Private Function GetFolder(ByVal TargetFolderPath As String, ByVal AccPath As String) As Folder
Dim targetFolder As Folder
Dim FoldersArray As Variant
Dim i As Integer
Dim ns As NameSpace
Dim inbox As Folder


On Error GoTo GetFolder_Error
Set ns = GetNamespace("MAPI")
Set inbox = ns.Folders(AccPath)
Set targetFolder = inbox.Folders.Item(TargetFolderPath)
Set GetFolder = targetFolder
Exit Function


GetFolder_Error:
On Error GoTo CreateFolder_Error
inbox.Folders.Add TargetFolderPath
Set targetFolder = inbox.Folders.Item(TargetFolderPath)
Set GetFolder = targetFolder
Exit Function


CreateFolder_Error:
Set GetFolder = Nothing
Exit Function
End Function