vba - 错误 440 "Array Index out of Bounds"

Question

我正在尝试下载带有主题关键字的 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

Answer 1

过滤器可能返回零个项目。

Set Items = Inbox.Items.Restrict(Filter)

If Items.Count > 0 then

    For i = 1 To Items.Count