Question

I have the following vba code is part of a larger script. The issue I am having is that that the SaveAs function continuously throws an error even though the Outlook message has been saved to a directory on the system. Inspection of the the Err object yields no results as everything is either blank or 0.

Another weird issue is that when the error handling code is commented out as it is below, the script executes correctly without any error being thrown. To me it seems that the error handling code itself causes the issue. VSTO is NOT an option at the moment.

1. Are there alternatives to the
   approach below?
2. Can you provide some
   useful debugging tips to aid this
   situation?

This is the code I’m using

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

Solution:

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

Place an Exit Sub/Function before the ErrorHandler.

Your code is executing correctly, but you are executing the ErrorHandler always.

You only want the error code to execute on error, not always. You need to exit the Function/Sub if no error Occurs.

Something like

...
iCount = iCount + 1 

NoError:
    Exit Sub 

ErrorHandler: 
...

From Error Handling In VBA

Something like

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