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。因此，如果列表中只有一个项目，它将位于Items（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

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

3 个答案: