EXCEL VBA ruft die Funktion FindClose auf und stürzt ab

Public Declare PtrSafe Function FindClose Lib "kernel32" (ByVal _  
        hFindFile As Long) As Long

Option Explicit

Public Declare PtrSafe Function GetLogicalDrives _
       Lib "kernel32" () As Long  

Public Declare PtrSafe Function GetDriveType _
       Lib "kernel32" Alias "GetDriveTypeA" _  
       (ByVal lpRootPathName As String) As Integer

Public Declare PtrSafe Function GetLogicalDriveStrings _
       Lib "kernel32" Alias "GetLogicalDriveStringsA" _  
      (ByVal nBufferLength As Long, _
       ByVal lpBuffer As String) As Long
       
       
Public Declare PtrSafe Function FindFirstFile Lib "kernel32" _  
        Alias "FindFirstFileA" (ByVal lpFileName As String, _  
        lpFindFileData As WIN32_FIND_DATA) As Long
       
Public Declare PtrSafe Function FindNextFile Lib "kernel32" _  
        Alias "FindNextFileA" (ByVal hFindFile As Long, _  
        lpFindFileData As WIN32_FIND_DATA) As Long
       
Public Declare PtrSafe Function FindClose Lib "kernel32" (ByVal _  
        hFindFile As Long) As Long

Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Const MAX_PATH = 259

Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nxFilesizeHigh As Long
  nxFilesizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Sub GetAllFiles(ByVal Root$, ByVal strPath$, ByRef Field$(), ByRef lngFileAttributes&(), ByVal strSearchFile$, ByVal strInstanz&)
 'Findet alle (auch Hidden und System) strSearchFile$ im angegebenen Root  
  'Procedur wird Recursiv aufgerufen  
 Dim File$, hFile&, FD As WIN32_FIND_DATA
 Dim SFile$, ShFile&, SFD As WIN32_FIND_DATA
 Dim xAttrib&
 Dim SRoot$
 strInstanz = strInstanz + 1
 If Right(Root, 1) <> "\" Then Root = Root & "\"  
 
 If strInstanz = 1 Then
  SRoot = Root
   ShFile = FindFirstFile(SRoot & strSearchFile$, SFD)
   If ShFile > 0 Then
    Do
     SFile = Left(SFD.cFileName, InStr(SFD.cFileName, Chr(0)) - 1)
     If Not (SFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
       If (SFile <> ".") And (SFile <> "..") Then  
        Field(UBound(Field)) = SRoot & SFile
        lngFileAttributes(UBound(Field)) = SFD.dwFileAttributes
        ReDim Preserve Field(0 To UBound(Field) + 1)
        ReDim Preserve lngFileAttributes&(0 To UBound(Field))
       End If
     End If
    Loop While FindNextFile(ShFile, SFD)
  End If
 End If
   
 hFile = FindFirstFile(Root & strPath, FD)
 If hFile = 0 Then Exit Sub
 Do
  File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
  xAttrib& = FD.dwFileAttributes
  If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
   If (File <> ".") And (File <> "..") Then  
    SFile = File
    SRoot = Root
    GetAllFiles Root & File, strPath, Field, lngFileAttributes, strSearchFile$, (strInstanz)
    If Right(SFile, 1) <> "\" Then SFile = SFile & "\"  
    SRoot = SRoot & SFile
    ShFile = FindFirstFile(SRoot & strSearchFile$, SFD)
    If ShFile > 0 Then
     Do
      SFile = Left(SFD.cFileName, InStr(SFD.cFileName, Chr(0)) - 1)
      If Not (SFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
       If (SFile <> ".") And (SFile <> "..") Then  
        Field(UBound(Field)) = SRoot & SFile
        lngFileAttributes(UBound(Field)) = SFD.dwFileAttributes
        ReDim Preserve Field(0 To UBound(Field) + 1)
        ReDim Preserve lngFileAttributes&(0 To UBound(Field))
       End If
      End If
     Loop While FindNextFile(ShFile, SFD)
    End If
   End If
   Call FindClose(ShFile)
  End If
 Loop While FindNextFile(hFile, FD)
 Call FindClose(ShFile)
End Sub

Sub GetAllDirctory(ByVal Root$, ByVal strPath$, ByRef Field$(), ByRef lngFileAttributes&(), ByVal strSearchFile$, ByVal strInstanz&)
 'Findet alle (auch Hidden und System) strSearchFile$ im angegebenen Root  
 'Procedur wird Recursiv aufgerufen  
 Dim File$, hFile&, FD As WIN32_FIND_DATA
 Dim SFile$, ShFile&, SFD As WIN32_FIND_DATA
 Dim xAttrib&
 Dim SRoot$
 strInstanz = strInstanz + 1
 If Right(Root, 1) <> "\" Then Root = Root & "\"  
 
 If strInstanz = 1 Then
  SRoot = Root
   ShFile = FindFirstFile(SRoot & strSearchFile$, SFD)
   If ShFile > 0 Then
    Do
     SFile = Left(SFD.cFileName, InStr(SFD.cFileName, Chr(0)) - 1)
     If (SFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
      If (SFile <> ".") And (SFile <> "..") Then  
       Field(UBound(Field)) = SRoot & SFile
       lngFileAttributes(UBound(Field)) = SFD.dwFileAttributes
       ReDim Preserve Field(0 To UBound(Field) + 1)
       ReDim Preserve lngFileAttributes&(0 To UBound(Field))
      End If
     End If
    Loop While FindNextFile(ShFile, SFD)
  End If
 End If
   
 hFile = FindFirstFile(Root & strPath, FD)
 If hFile = 0 Then Exit Sub
 Do
  File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
  xAttrib& = FD.dwFileAttributes
  If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
   If (File <> ".") And (File <> "..") Then  
    SFile = File
    SRoot = Root
    GetAllDirctory Root & File, strPath, Field, lngFileAttributes, strSearchFile$, (strInstanz)
    If Right(SFile, 1) <> "\" Then SFile = SFile & "\"  
    SRoot = SRoot & SFile
    ShFile = FindFirstFile(SRoot & strSearchFile$, SFD)
    If ShFile > 0 Then
     Do
      SFile = Left(SFD.cFileName, InStr(SFD.cFileName, Chr(0)) - 1)
      If (SFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
       If (SFile <> ".") And (SFile <> "..") Then  
        Field(UBound(Field)) = SRoot & SFile
        lngFileAttributes(UBound(Field)) = SFD.dwFileAttributes
        ReDim Preserve Field(0 To UBound(Field) + 1)
        ReDim Preserve lngFileAttributes&(0 To UBound(Field))
       End If
      End If
     Loop While FindNextFile(ShFile, SFD)
    End If
   End If
   Call FindClose(ShFile)
  End If
 Loop While FindNextFile(hFile, FD)
 Call FindClose(ShFile)
End Sub