Problem mit Application.FileSearch

Sub Sammeln()
Dim intFilecount As Integer
Dim strFilename As String
Dim objSheet As Worksheet
Dim strOrt As String
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrt = .SelectedItems(1)
If Right(strOrt, 1)  "\" Then strOrt = strOrt & "\"
Else
strOrt = ""
End If
End With
If strOrt = "" Then MsgBox ("Kein Ordner gewählt!") Else MsgBox strOrt
Set objSheet = ThisWorkbook.Worksheets("(7) Sammeln")
With Application.FileSearch
.NewSearch
.LookIn = strOrt
.FileType = msoFileTypeExcelWorkbooks
.Execute
For intFilecount = 1 To .FoundFiles.Count
strFilename = Dir$(.FoundFiles.Item(intFilecount))
GetObject (.FoundFiles.Item(intFilecount))
With Workbooks(strFilename).Worksheets(1)
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, _
1).End(xlUp).Row + 1, 8)).Copy _
objSheet.Cells(objSheet.Rows.Count, 1). _
End(xlUp).Offset(2, 0)
End With
Next
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub