2017-04-14 19 views
3

Ich versuche, eine Excel-Anlage mit dem Betreff-Schlüsselwort herunterzuladen.Fehler 440 "Array-Index außerhalb der Grenzen"

Ich schaffte es, einen Code zu erstellen, aber manchmal gibt es Fehler 440"Array Index out of Bounds".

Der Code ist in diesem Teil stecken geblieben.

If Items(i).Class = Outlook.OlObjectClass.OlMail Then 

Hier ist der Code

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 

Antwort

2

Es war mein Verständnis, dass Arrays in vba bei 0 standardmäßig gestartet. Wenn Sie also nur einen Eintrag in der Liste haben, befindet er sich unter Posten (0). Und da Ihre for-Anweisung mit der Betrachtung von Items (1) beginnt, wird dieser Fehler ausgelöst. Ändern zu:

For i = 0 To Items.Count - 1 

sollte funktionieren, glaube ich.

+0

danke ich werde meinen Code zwicken .. Danke für die Hilfe –

1

Keine Notwendigkeit für einfach mehrere Punktobjekten Einrichten verwenden

If Items(i).Class = olMail Then

Sie können auch Ihre Objekte nichts wollen setzen, sobald Ihr mit ihnen ...

getan
Set Inbox = Nothing 
    Set obj = Nothing 
    Set Items = Nothing 
    Set Attach = Nothing 
    Set MailItem = Nothing 
End Sub 
+0

danke für die Hilfe –

1

Der Filter kann null Elemente zurückgeben.

Set Items = Inbox.Items.Restrict(Filter) 

If Items.Count > 0 then 

    For i = 1 To Items.Count 
Verwandte Themen