1

我有以下 vba 代码是较大脚本的一部分。我遇到的问题是即使 Outlook 消息已保存到系统上的目录中，SaveAs 函数也会不断抛出错误。检查 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
4

3 回答 3

4

在ErrorHandler之前放置一个退出子/函数。

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

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

就像是

...
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
于 2010-02-16T08:04:35.010 回答
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
于 2010-02-16T08:15:57.600 回答
0

在我的环境中工作得很好，稍微修改了你上面的（我删除了 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
于 2010-02-16T08:44:35.403 回答