Добрый день.

Outlook 2010

Задача - перемещение писем из папки "Входящие" в папку "Personal".
Просьба помочь найти ошибку, - программа отрабатывает, но письма не перемещает.

Папки "Входящие" и "Personal" находятся на одном уровне.
Это первый этап задачи, на втором - будет добавлено условие.


!!! ВНИМАНИЕ модуль запускать только на тестовом почтовом ящике, так как во время отладки может быть удаление писем из папки Входящие без возможности восстановления.
Спасибо.

Private Function addOutlookFolderIfNotExists() As MAPIFolder
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Set apOutlook = CreateObject("Outlook.Application")
apOutlook.Session.Logon

Set myNameSpace = apOutlook.GetNamespace("MAPI")
' Папка-источник
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("Входящие")
' Папка-назначение
Set myNewFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("Personal")
If Not myNewFolder Is Nothing Then
MsgBox myNewFolder ' ПРОВЕРКА - программа определила папку Personal, как существующую
End If

For Each myItem In myFolder.Items
Set myItemNew = myItem.Copy
myItemNew.Move myNewFolder ' Команда не перемещает письма, письма остаются в папке Входящие
Next

End Function

The_Prist,
Спасибо, модуль проверила, он работает без ошибок.

Но, из папки "Входящие" письмо ушло, а в папку "Personal" не пришло (то есть произошло не перемещение, а удаление письма).

Проверила, в условие ниже не попадает, то есть папка "Personal" обнаружена программой
If myNewFolder Is Nothing Then
Exit Sub
End If
Понимаю, что причина неправильной работы на моей стороне, но не понимаю, в чём она.

Просьба помочь.

Спасибо.

The_Prist,
спасибо большое, разбираюсь с причиной, она в настройках почты на моём ПК