錯誤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