错误440“数组索引超出界限”

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

这是我的理解是，在VBA数组默认为0开始。因此，如果列表中只有一个项目，它将位于项目（0）中。而且因为你的for语句从查看Items（1）开始，它会抛出这个错误。更改为：

For i = 0 To Items.Count - 1 

应该工作，我相信。

Answer 2

无需设置多个点的对象只需使用

If Items(i).Class = olMail Then

你也可以想设置你的对象没有什么，一旦你与他们做...

Set Inbox = Nothing 
    Set obj = Nothing 
    Set Items = Nothing 
    Set Attach = Nothing 
    Set MailItem = Nothing 
End Sub 

Answer 3

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

Set Items = Inbox.Items.Restrict(Filter) 

If Items.Count > 0 then 

    For i = 1 To Items.Count