views:

87

answers:

2

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
+3  A: 

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 
astander
How so? Wont that just exit the Sub every time?
Ahmad
That should be a next, shouldn't it?
roe
Correct, I refactored the error handler to the end of the Sub, the main reason being is that I did not want to completely exit until all items have been processed
Ahmad
You might want to then move the code within the for loop to another Sub/Function that handles a single item a time, and hanles the errors there.
astander
Most definitely agree with that. In this case though would Resume return control back to the For Loop even if the new Sub has errors?
Ahmad
+1  A: 

You will have to make sure your errorhandler only executes when an error actually has occured. I'd try something like this, but you'll have to adapt it to the rest of the sub:

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

  Exit Sub
ErrorHandler:
   // ...
End Sub

An alternative might be:

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

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