Outlook ошибка проверки писем

Вторник, 14 Апреля 2015 г. 23:43 + в цитатник

Господа, снова с просьбой помочь...
У меня 2007, у человека тоже 2007
У человека в цикле по письмам в папке входящие выпадает с ошибкой.Писем порядка 4000, выпадает гдето на 1800м

Private OL_ItemMail As Outlook.MailItem

'спиcок писем в папке "входящие"
Function EmailInbox()
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderMail As Outlook.MAPIFolder
Dim InitiationMaill As Long, HEARINGMaill As Long
Dim myItems As Outlook.Items
Dim n As Long

   On Error GoTo EmailInbox_Error
 
er = 1
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")

er = 2
'получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")

er = 3
' получаем ссылку на папку Входящие
Set OL_FolderMail = OL_NameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = OL_FolderMail.Items 

er = 4
' перебираем все письма в папке
For Each OL_ItemMail In myItems 
    
    With OL_ItemMail
er = 50
        If .UnRead Then ' фильтр по непрочитанным
              ' здесь идет обработка писем
        End If
    End With
' на 1800 письме после следующей строки сразу выпадает в ошибку
Next
    
   On Error GoTo 0
   Exit Function

EmailInbox_Error:
' здесь обработка ошибок    
End Function