Question

我有以下vba代码是更大脚本的一部分。我遇到的问题是即使Outlook消息已保存到系统上的目录，SaveAs函数也会不断抛出错误。检查Err对象不会产生任何结果，因为所有内容都是空白或0。

另一个奇怪的问题是，当错误处理代码被注释掉时，脚本会正确执行，而不会抛出任何错误。对我来说，似乎错误处理代码本身会导致问题。 VSTO目前不是一种选择。

是否有替代方案接近下面？
你能提供一些吗？有用的调试技巧来帮助这个情况？

这是我正在使用的代码

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

在 ErrorHandler 之前放置退出子/功能。

您的代码正在正确执行，但您始终在执行ErrorHandler。

您只希望错误代码在出错时执行，而不是总是如此。如果没有错误发生，则需要退出Function / Sub。

像

这样的东西

...
iCount = iCount + 1 

NoError:
    Exit Sub 

ErrorHandler: 
...

来自Error Handling In 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

为什么SaveAs方法会抛出错误？

3 个答案: