Почему метод SaveAs выдает ошибку?

Question

У меня следующий код VBA является частью большего сценария. У меня проблема в том, что функция SaveAs постоянно выдает ошибку, даже если сообщение Outlook было сохранено в каталоге в системе. Проверка объекта Err не дает результатов, так как все либо пустое, либо 0.

Другая странная проблема заключается в том, что когда код обработки ошибок закомментирован, как показано ниже, сценарий выполняется правильно, без каких-либо ошибок. Мне кажется, что сам код ошибки обрабатывает проблему. VSTO на данный момент НЕ является опцией.

1. Есть ли альтернативы Подход ниже?
2. Можете ли вы предоставить некоторые полезные советы по отладке, чтобы помочь этому ситуация?

Это код, который я использую

For Each itm In itemsToMove  
    Dim mItem As MailItem  
    Set mItem = itm  

    ' On Error Resume Next
    sSubject = mItem.Subject
    sDate = Format(mItem.CreationTime, "yyyymmdd_hhnnss_")
    FNme = DirName & sDate & StripIllegalChar(sSubject) & ".msg"
    **mItem.SaveAs FNme, olMSG**
    iCount = iCount + 1

    'ErrorHandler:
    '            MsgBox ("The email " & FNme & " failed to save.")
    '            MsgBox Err.Description & " (" & Err.Number & ")"
    '            Set objNameSpace = Nothing
    '            Set objOutlook = Nothing
    '            Set objNameSpace = Nothing
    '            Set objInbox = Nothing
    '            Set objInbox = Nothing
    '            Set itemsToMove = Nothing
    '            Set itemsToMove = Nothing
    '            Exit Sub
 Next

Решение:

Sub SomeSub
....
.... 
For Each itm In itemsToMove
    Dim mItem As MailItem
    Set mItem = itm

    On Error GoTo ErrorHandler
    sSubject = mItem.Subject
    sDate = Format(mItem.CreationTime, "yyyymmdd_hhnnss_")
    FNme = DirName & sDate & StripIllegalChar(sSubject) & ".msg"
    mItem.SaveAs FNme, olMSG
    iCount = iCount + 1
 Next
End If
Exit Sub

ErrorHandler:
   MsgBox ("The email " & FNme & " failed to save.")
   MsgBox Err.Description & " (" & Err.Number & ")"
   Set objNameSpace = Nothing
   Set objOutlook = Nothing
   Set objNameSpace = Nothing
   Set objInbox = Nothing
   Set objInbox = Nothing
   Set itemsToMove = Nothing
   Set itemsToMove = Nothing
   Resume Next
End Sub

Answer 1

Поместите Выход Sub / Function перед ErrorHandler .

Ваш код выполняется правильно, но вы всегда выполняете ErrorHandler.

Вы хотите, чтобы код ошибки выполнялся только при ошибке, а не всегда. Вам необходимо выйти из функции / субмашины, если не происходит ошибки.

Что-то вроде

...
iCount = iCount + 1 

NoError:
    Exit Sub 

ErrorHandler: 
...

С Обработка ошибок в VBA

Что-то вроде

On Error Goto ErrHandler:
N = 1 / 0    ' cause an error
'
' more code
'
Exit Sub 'THIS IS WHAT YOU ARE MISSING
ErrHandler:
' error handling code
Resume Next
End Sub 

Answer 2

Вы должны будете убедиться, что ваш обработчик ошибок выполняется только тогда, когда ошибка действительно произошла. Я бы попробовал что-то подобное, но вам придется адаптировать его к остальной части sub:

Sub ...
  // ...
  On Error goto errorhandler
  For Each itm In itemsToMove
    //...
    mItem.SaveAs FNme, olMSG
    iCount = iCount + 1
  Next     

  Exit Sub
ErrorHandler:
   // ...
End Sub

Альтернативой может быть:

  For Each itm In itemsToMove
    On Error goto errorhandler
    //...
    mItem.SaveAs FNme, olMSG
    iCount = iCount + 1
    goto NoError

    ErrorHandler:
      //...
      Exit sub
    NoError:
  Next     

Answer 3

Работает просто отлично в моей среде, немного изменено по сравнению с вашей (я удалил подпрограмму StripIllegalChar, так как она не была опубликована):

Sub SaveAsItems()
Dim MAPINS As NameSpace
Set MAPINS = Application.GetNamespace("MAPI")
Dim inboxFolder As Folder
Set inboxFolder = MAPINS.GetDefaultFolder(olFolderInbox)
Dim itemsToMove As items
Set itemsToMove = inboxFolder.items
Dim mItem As MailItem
DirName = "C:\Users\Me\Desktop\files\"
For Each itm In itemsToMove
    Set mItem = itm
    sSubject = mItem.Subject
    sDate = Format(mItem.CreationTime, "yyyymmdd_hhnnss_")
    FNme = DirName & sDate & ".msg"
    mItem.SaveAs FNme, olMSG
Next
End Sub