错误440“数组索引越界"? [英] Error 440 "Array Index out of Bounds"

问题描述

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

I am trying to download an Excel attachment with the subject keyword.

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

I managed to create a code but sometimes it is giving Error 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)开始，因此将引发该错误.更改为:

It was my understanding that arrays in vba started at 0 by default. So if there is only one item in the list it will be located at Items(0). And since your for statement starts by looking at Items(1) it will throw that error. Changing it to:

For i = 0 To Items.Count - 1

我相信应该可以.

这篇关于错误440“数组索引越界"?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！