错误 440“数组索引越界”

我正在尝试下载带有主题关键字的 Excel 附件。

我设法创建了一个代码，但有时它给出了错误440 "Array Index out of Bounds".

代码就卡在这部分了。

If Items(i).Class = Outlook.OlObjectClass.OlMail Then

这是代码

Sub Attachment()  
    Dim N1 As String
    Dim En As String
    En = CStr(Environ("USERPROFILE"))
    saveFolder = En & "\Desktop\"
    N1 = "Mail Attachment"

    If Len(Dir(saveFolder & N1, vbDirectory)) = 0 Then
        MkDir (saveFolder & N1)
    End If

    Call Test01

End Sub

Private Sub Test01()

    Dim Inbox As Outlook.Folder
    Dim obj As Object
    Dim Items As Outlook.Items
    Dim Attach As Object
    Dim MailItem As Outlook.MailItem
    Dim i As Long
    Dim Filter As String
    Dim saveFolder As String, pathLocation As String
    Dim dateFormat As String
    Dim dateCreated As String
    Dim strNewFolderName As String
    Dim Creation As String

    Const Filetype1 As String = "xlsx"
    Const Filetype2 As String = "xlsm"
    Const Filetype3 As String = "xlsb"
    Const Filetype4 As String = "xls"

    Dim Env As String
    Env = CStr(Environ("USERPROFILE"))
    saveFolder = Env & "\Desktop\Mentor Training\"

    Set Inbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    'If Inbox.Items.Restrict("[UnRead] = True").Count = 0 Then
     '   MsgBox "No Mentor Training Mail In Inbox"
     '   Exit Sub
    'End If

    Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
        Chr(34) & " >= '4/2/2017' AND " & _
        Chr(34) & "urn:schemas:httpmail:hasattachment" & _
        Chr(34) & "=1 AND" & Chr(34) & _
        Chr(34) & "urn:schemas:httpmail:read" & _
        Chr(34) & "= 0"

    Set Items = Inbox.Items.Restrict(Filter)

    For i = 1 To Items.Count
        If Items(i).Class = Outlook.OlObjectClass.olMail Then
            Set obj = Items(i)
            Debug.Print obj.subject
            For Each Attach In obj.Attachments
                If Right(LCase(Attach.fileName), Len(Filetype1)) = Filetype1 Then 'For searching only excel files
                    dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
                    Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
                End If
                If Right(LCase(Attach.fileName), Len(Filetype2)) = Filetype2 Then 'For searching only excel files
                    dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
                    Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
                End If
                If Right(LCase(Attach.fileName), Len(Filetype3)) = Filetype3 Then 'For searching only excel files
                    dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
                    Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
                End If
                If Right(LCase(Attach.fileName), Len(Filetype4)) = Filetype4 Then 'For searching only excel files
                    dateFormat = Format(obj.ReceivedTime(), "dd-mm-yyyy hh-mm")
                    Attach.SaveAsFile saveFolder & "(" & dateFormat & ")" & " " & Attach
                End If
                obj.UnRead = False
                DoEvents
                obj.Save
            Next

        End If
    Next
    MsgBox "Attachment Saved"
End Sub

据我了解，vba 中的数组默认从 0 开始。因此，如果列表中只有一项，它将位于 Items(0)。由于您的 for 语句首先查看 Items(1) ，因此它会抛出该错误。将其更改为：

For i = 0 To Items.Count - 1

我相信应该有效。