AW: Problem Ordner einlesen Win8/ Excel 2013
29.09.2016 17:23:31
Volker
Oh man.
Der kleine Text "Variablen anpassen" zeigt mir, dass ich mich in diesen Dingen so überhaupt nicht aus kenne. Ich sollte mich wohl mit dem Thema Variablen etwas näher befassen. :-(
Vielleicht kannst du mir da noch nen Tipp geben, Nepumuk?
Hier sind die 2 Makros. Beim ersten FindFirstFile... kommt auch gleich die Fehlermeldung!
Besten Dank schon mal!!!!
Sub GetAllFiles(ByVal Root$, ByVal strPath$, ByRef Field$(), ByRef lngFileAttributes&(), ByVal _
strSearchFile$, ByVal strInstanz&)
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
Stop
Loop While FindNextFile(hFile, FD)
Call FindClose(hFile)
End Sub
Sub GetAllDirctory(ByVal Root$, ByVal strPath$, ByRef Field$(), ByRef lngFileAttributes&(), _
ByVal strSearchFile$, ByVal strInstanz&)
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(hFile)
End Sub