"Subscript out of range" - 中断模式工作正常

"Subscript out of range" - break mode works fine

正如标题所说,我的代码中出现下标超出范围错误...但奇怪的是,当我进入中断模式进行调试时,该错误从未触发。

为了排除故障,我在代码中添加了一个断点,直到收到错误。然后我逐行向上移动断点,直到找到 "breaking" 允许代码执行的位置。在这些情况下,代码会执行到接收到另一个错误的较低函数(应该是,我仍在调试。

这似乎是有问题的代码块。当我在循环结束时中断并按住 F5,它会完全执行。如果代码后面没有中断模式或断点,则会抛出下标错误。

'get all items in desired inbox, add all items to collection
Set supportBox = owaNamespace.Folders("FOLDER NAME REMOVED").Folders("Inbox")
Set allMailItems = supportBox.Items

'create array of MailItems to hold desired emails
Dim validItems() As Outlook.mailItem

'iterate through all items to look for valid notices
For Each oItem In allMailItems

    'function takes an item, confirms if MailItem from desired sender
    If IsValidNoticeEmail(oItem, MAIL_ITEM, SENDER_EMAIL) Then

        'convert object to MailItem before adding to array
        Dim newMail As Outlook.mailItem
        Set newMail = oItem

        'Get current array upper index
        Dim oldLength As Integer
        oldLength = UBound(validItems)

        'expand array by one at upper bound and add mail item at that location
        ReDim Preserve validItems(oldLength + 1)
        Set validItems(oldLength + 1) = newMail

    End If
Next oItem

所以不确定这是否是用户错误(5 年多后返回 VBA),或者是否可能存在时间问题,中断为未完成的初始化步骤提供了足够的时间准时 运行 代码不间断。

你可以反其道而行之:

  • 首先,将数组的大小设为可能有效邮件的最大数量

  • 然后,一旦循环结束,将其大小调整为找到的有效邮件项目的实际数量

如下:

'get all items in desired inbox, add all items to collection
Set supportBox = owaNamespace.Folders("FOLDER NAME REMOVED").Folders("Inbox")
Set allMailItems = supportBox.Items
if allMailItems.Count = 0 Then Exit Sub

'create array of MailItems to hold desired emails
Dim oldLength As Integer
Dim newMail As Outlook.mailItem
ReDim validItems(1 to allMailItems.Count) As Outlook.mailItem

'iterate through all items to look for valid notices
For Each oItem In allMailItems

    'function takes an item, confirms if MailItem from desired sender
    If IsValidNoticeEmail(oItem, MAIL_ITEM, SENDER_EMAIL) Then

       'convert object to MailItem before adding to array
        Set newMail = oItem

        'Update current array upper index
        oldLength = oldLength + 1

        Set validItems(oldLength) = newMail

    End If
Next oItem
'Resize array to actual number of valid mail items or erase it if no valid mail items found
If oldLength >0 Then
    ReDim Preserve validItems(1 to oldLength)
Else
    Erase validItems
End If