Nur bestimmte Anhänge speichern

Private Sub myOlItems_ItemAdd(ByVal Item As Object)
  Const sPfad  As String = "C:\Daten\Outlook-Anhang"  
    
    Dim iAttachCnt As Integer
    Dim i As Integer
    Dim myItem As Outlook.MailItem
    Dim DateFolderPath As String
    Dim fso As Object
       
    DateFolderPath = sPfad & "\" & Format(Date, "dd-mm-yyyy")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    
    If Not fso.FolderExists(sPfad) Then
        fso.CreateFolder sPfad
    End If

    If Not fso.FolderExists(DateFolderPath) Then
        fso.CreateFolder DateFolderPath
    End If
    
    If TypeName(Item) = "MailItem" Then  
    With Item.Attachments
      iAttachCnt = .Count
      If iAttachCnt > 0 Then
       'For i = 1 To iAttachCnt then <--- Mit dieser Variante werden alle Anlagen abgespeichert, ist aber nicht Ziel  
        For i = 1 To iAttachCnt and LCase(Right(Item.FileName, 4)) = ".pdf" Then <--- Hier kommt der Laufzeitfehler 91  
          .Item(i).SaveAsFile DateFolderPath & "\" & .Item(i).FileName  
        Next i
      End If
    End With
  End If
  End Sub