Makro Suche bricht ab ohne Meldung

Public Sub searchHyperlink()
'Suche nach APQP Dateien mit Datum hinter Namen, wenn kein Datum wird die Liste verlinkt!
Dim objFileSearch As clsFileSearch
Dim objWB As Workbook, objSh As Worksheet, objThisSH As Worksheet, objFind As Range
Dim lngIndex As Long, lngRow As Long
Dim strPath As String, strName As String, strFirstAddress As String
On Error GoTo err_exit
strName = InputBox("Bitte gesuchten Namen eingeben!", "Hyperlinkliste", "?")
If strName  CStr(False) And (Len(strName)) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "T:\05_UP\80_Kunden\Neu\Kunden\" 'Startverzeichnis "T:\05_UP\ _
80_Kunden\Neu\Kunden\"
.Title = "Hyperlink erstellen - Ordnerwahl"
.ButtonName = "Start..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPath = .SelectedItems(1) & "\"
End If
End With
If Len(strPath) Then
Set objThisSH = ThisWorkbook.Sheets("Hyperlink") 'Ausgabeblatt in dieser Datei
With objThisSH
.Unprotect Password:="dobro"
.Range("A2:A" & Rows.Count).ClearContents
.Range("A1") = "Dateien unerledigt für '" & strName & "'"
End With
lngRow = 2
Set objFileSearch = New clsFileSearch
With objFileSearch
.NewSearch = True
.CaseSenstiv = False
.Extension = "*.xls*"
.FolderPath = strPath
.SearchLike = "*APQP*.xls*"
.SubFolders = True
If .Execute(Sort_by_Date_Create, Sort_Order_Descending) > 0 Then
For lngIndex = 1 To .FileCount
If Left$(.Files(lngIndex).FI_FileName, 2)  "~$" Then
Set objWB = Workbooks.Open(.Files(lngIndex).FI_FullName, ReadOnly:=  _
_
True)
If ProjectStart(objWB) Then
For Each objSh In objWB.Worksheets
If objSh.Name Like "CL-Phase*" Then
Set objFind = objSh.Range("H:H").Find(What:=strName,  _
Lookat:=xlWhole, _
LookIn:=xlValues, MatchCase:=False, SearchFormat:=  _
_
False)
If Not objFind Is Nothing Then
strFirstAddress = objFind.Address
Do
If Not IsDate(objFind.Offset(0, 4).Value) Then
objThisSH.Hyperlinks.Add Anchor:=objThisSH.  _
_
Cells(lngRow, 1), _
Address:=objWB.FullName, TextToDisplay:= _
_
objWB.FullName
objThisSH.Cells(lngRow, 1).Style = " _
Hyperlink"
lngRow = lngRow + 1
Exit For
End If
Set objFind = objSh.Range("H:H").FindNext(After: _
_
=objFind)
Loop Until objFind.Address = strFirstAddress
End If
End If
Next
End If
objWB.Close False
End If
Next
End If
End With
End If
objThisSH.Protect Password:="dobro"
End If
sub_exit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
Set objFileSearch = Nothing
Set objThisSH = Nothing
Set objWB = Nothing
Set objSh = Nothing
Set objFind = Nothing
Exit Sub
err_exit:
Call MsgBox("Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Programmfehler")
Resume sub_exit
End Sub

Private Function ProjectStart(ByRef probjWorkbook As Workbook) As Boolean
' hier wird das Initialdatum abgefragt! Wenn kein Datum Eingetragen ist wird die Liste nicht  _
berücksichtigt!
Dim objWorksheet As Worksheet
For Each objWorksheet In probjWorkbook.Worksheets
If objWorksheet.Name = "Projekt- und QM-Plan" Then
If IsDate(objWorksheet.Cells(4, 9).Value) Then
ProjectStart = True
Exit For
End If
End If
Next
Set objWorksheet = Nothing
End Function

Private Sub FindFiles(ByVal strFolderPath As String)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
On Error GoTo ErrorHandling
If Right$(strFolderPath, 1)  "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
If lngSearch  INVALID_HANDLE_VALUE Then
Call GetFilesInFolder(strFolderPath)
If mblnSubFolders Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
If (strDirName  ".") And (strDirName  "..") Then _
Call FindFiles(strFolderPath & strDirName)
End If
Loop While FindNextFile(lngSearch, WFD)
End If
FindClose lngSearch
End If
Exit Sub
ErrorHandling:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehler"
End Sub

Private Sub GetFilesInFolder(ByVal strFolderPath As String)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, FI_FileName As String
Dim udtFiletime As FILETIME, udtSystemtime As SYSTEMTIME
On Error GoTo ErrorHandling
If Right$(strFolderPath, 1)  "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & mstrExtension, WFD)
If lngSearch  INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)  FILE_ATTRIBUTE_DIRECTORY   _
_
Then
FI_FileName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
If IIf(mblnCaseSenstiv, FI_FileName, LCase$(FI_FileName)) Like _
IIf(mblnCaseSenstiv, mstrSearchLike, LCase$(mstrSearchLike)) Then
mlngFileCount = mlngFileCount + 1
ReDim Preserve mudtFiles(1 To mlngFileCount)
With mudtFiles(mlngFileCount)
.FI_FullName = strFolderPath & FI_FileName
.FI_FolderPath = strFolderPath
.FI_FileName = FI_FileName
.FI_FileSize = WFD.nFileSizeLow
FileTimeToLocalFileTime WFD.ftCreationTime, udtFiletime
FileTimeToSystemTime udtFiletime, udtSystemtime
.FI_DateCreate = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime. _
wMonth, udtSystemtime.wDay) + _
TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute,  _
udtSystemtime.wSecond))
FileTimeToLocalFileTime WFD.ftLastAccessTime, udtFiletime
FileTimeToSystemTime udtFiletime, udtSystemtime
.FI_LastAccess = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime. _
wMonth, udtSystemtime.wDay) + _
TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute,  _
udtSystemtime.wSecond))
FileTimeToLocalFileTime WFD.ftLastWriteTime, udtFiletime
FileTimeToSystemTime udtFiletime, udtSystemtime
.FI_LastModify = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime. _
wMonth, udtSystemtime.wDay) + _
TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute,  _
udtSystemtime.wSecond))
End With
End If
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
Exit Sub
ErrorHandling:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehler"
End Sub

Private Sub prcSort(lngLBorder As Long, lngUBorder As Long, enmSortBy As SORT_BY, enmSortOrder   _
_
As SORT_ORDER)
Dim lngIndex1 As Long, lngIndex2 As Long
Dim udtBuffer As FILEINFO, vntTemp As Variant
lngIndex1 = lngLBorder
lngIndex2 = lngUBorder
Select Case enmSortBy
Case Sort_by_Name: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).FI_FileName
Case Sort_by_Path: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).FI_FullName
Case Sort_by_Size: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).FI_FileSize
Case Sort_by_Last_Access: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2). _
FI_LastAccess
Case Sort_by_Last_Modyfy: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2). _
FI_LastModify
Case Sort_by_Date_Create: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2). _
FI_DateCreate
End Select
Do
Select Case enmSortBy
Case Sort_by_Name
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).FI_FileName  vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).FI_FileName
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Path
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).FI_FullName  vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).FI_FullName
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Size
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).FI_FileSize  vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).FI_FileSize
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Last_Access
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).FI_LastAccess  vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).FI_LastAccess
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Last_Modyfy
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).FI_LastModify  vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).FI_LastModify
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Date_Create
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).FI_DateCreate  vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).FI_DateCreate
lngIndex2 = lngIndex2 - 1
Loop
End If
End Select
If lngIndex1  lngIndex2
If lngLBorder