title image


Smiley Re: wie liest man aus einem Ordner alle .txt Dateien ein ...
Einfach folgenden Code in ein Modul, und dann die Funktion SearchForFiles aufrufen.



Übergabeparameter:

strFolder = Laufwerk und Pfad, unter dem gesucht werden soll, muß mit "\" enden

strPath = "" wird intern für die Rekursion benötigt

strFileFilter = Suchfilter, zB "*.txt"

strListe = Rückgabe, Array, der alle gefundenen Dateien incl. Teilpfad ab strFolder enthält





Beispiel:

Dim strFiles() As String



SearchForFiles "C:\Programme\","","*.txt",strFiles



Gruß

Gaga









Option Explicit





Private Const MAX_PATH = 260

Private Const FILE_ATTRIBUTE_DIRECTORY = &H10





Private Type FILETIME

   dwLowDateTime As Long

   dwHighDateTime As Long

End Type



Private Type WIN32_FIND_DATA

   dwFileAttributes As Long

   ftCreationTime As FILETIME

   ftLastAccessTime As FILETIME

   ftLastWriteTime As FILETIME

   nFileSizeHigh As Long

   nFileSizeLow As Long

   dwReserved0 As Long

   dwReserved1 As Long

   cFileName As String * MAX_PATH

   cAlternate As String * 14

End Type





Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long





Private MlngArcCount As Long









'// +---------------------------------------------------------------------------

'// |

'// |    Rekursive Suche im Verzeichnis "strFolder" (incl. Unterverzeichnisse) nach allen

'// |    Dateien, die dem "FileFilter" entsprechen.

'// |    Die gefundenen Dateien werden incl. Pfad in die Liste "strListe" aufgenommen

'// |

'// +---------------------------------------------------------------------------

Public Sub SearchForFiles(ByRef strFolder As String, _

                          ByRef strPath As String, _

                          ByRef strFileFilter As String, _

                          ByRef strListe() As String)

Dim tFindData As WIN32_FIND_DATA

Dim strFileName As String

Dim strFileExt As String

Dim lngFindHdle As Long

Dim lngPos As Long

    

    lngFindHdle = FindFirstFile(strFolder & strPath & "*.*", tFindData)

    If lngFindHdle > 0 Then

        Do

            strFileName = tFindData.cFileName

            lngPos = InStr(1, strFileName, vbNullChar, vbBinaryCompare)

            If lngPos > 0 Then

                strFileName = Left$(strFileName, lngPos - 1)

            End If

            '// Wenn es sich um ein Verzeichnis handelt

            If (tFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _

                = FILE_ATTRIBUTE_DIRECTORY Then

                Select Case strFileName

                Case ".", ".."

                Case Else

                    '// Verzeichnis --> nächste Ebene

                    SearchForFiles strFolder, strPath & strFileName & "\", strFileFilter, strListe

                 End Select

            Else

                '// Datei --> in die Liste aufnehmen wenn die Datei dem FileFilter entspricht

                If CheckFileName(strFileName, strFileFilter) Then

                    ReDim Preserve strListe(MlngArcCount)

                    strListe(MlngArcCount) = strPath & strFileName

                    MlngArcCount = MlngArcCount + 1

                End If

            End If

        Loop While FindNextFile(lngFindHdle, tFindData) <> False

    End If

End Sub











'// +---------------------------------------------------------------------------

'// |

'// |    Überprüfung von Dateinamen

'// |       liefert True, wenn der Dateiname "strFile" dem Filter "strFilter" entspricht,

'// |       sonst False

'// |

'// +---------------------------------------------------------------------------

Private Function CheckFileName(ByVal strFile As String, _

                              ByVal strFilter As String) As Boolean

Dim strFilterExt As String

Dim strFileExt As String

Dim strFilterPre As String

Dim strFilePre As String

Dim intFragePos As Integer

Dim intSternPos As Integer

Dim intChar As Integer

Dim booExt As Boolean

Dim booPre As Boolean





   '// Filter in Prefix und Extension aufteilen

   SplitFileName strFilter, strFilterPre, strFilterExt

   '// Dateiname in Prefix und Extension aufteilen

   SplitFileName strFile, strFilePre, strFileExt



'// Dateierweiterungen überprüfen

   '// im Filter enthaltene Platzhalter lokalisieren

   intFragePos = InStr(strFilterExt, "?")

   intSternPos = InStr(strFilterExt, "*")

   intChar = Len(strFilterExt) - intSternPos

   '// Paßt die Extension zusammen

   If strFilterExt = "*" Or _

      strFilterExt = strFileExt Then

      booExt = True

   '// * im Filter

   ElseIf intSternPos <> 0 Then

      '// Stimmt der Teil vor dem Stern und der Teil nach dem Stern überein?

      If Left$(strFilterExt, intSternPos - 1) = Left$(strFileExt, intSternPos - 1) And _

         Right$(strFilterExt, intChar) = Right$(strFileExt, intChar) Then

         booExt = True

      End If

    '// Sind Filtererweiterung und Dateierweiterung gleich lang?

   ElseIf Len(strFilterExt) <> Len(strFileExt) Then

      booExt = False

      '// kein ? im Filter

   ElseIf intFragePos = 0 Then

      booExt = False

      '// ? im Filter;  Stimmt der Teil vor dem ? und der Teil nach dem ? überein?

   ElseIf Left$(strFilterExt, intFragePos - 1) = Left$(strFileExt, intFragePos - 1) And _

      Right$(strFilterExt, Len(strFilterExt) - intFragePos) = Right$(strFileExt, Len(strFilterExt) - intFragePos) Then

      booExt = True

   End If



   '// Extension stimmt nicht überein

   If Not booExt Then

      CheckFileName = booExt

      Exit Function

   End If



'// Dateiname überprüfen

   '// im Filter enthaltene Platzhalter lokalisieren

   intFragePos = InStr(strFilterPre, "?")

   intSternPos = InStr(strFilterPre, "*")

   intChar = Len(strFilterPre) - intSternPos

   '// Paßt der Dateiname zusammen

   If strFilterPre = "*" Or _

      strFilterPre = strFilePre Then

      booPre = True

   '// * im Filter

   ElseIf intSternPos <> 0 Then

      '// Stimmt der Teil vor dem Stern und der Teil nach dem Stern überein?

      If Left$(strFilterPre, intSternPos - 1) = Left$(strFilePre, intSternPos - 1) And _

         Right$(strFilterPre, intChar) = Right$(strFilePre, intChar) Then

         booPre = True

      End If

   '// Sind Filter und Datei gleich lang?

   ElseIf Len(strFilterPre) <> Len(strFilePre) Then

      booPre = False

      '// kein ? im Filter

   ElseIf intFragePos = 0 Then

      booPre = False

      '// ? im Filter;  Stimmt der Teil vor dem ? und der Teil nach dem ? überein?

   ElseIf Left$(strFilterPre, intFragePos - 1) = Left$(strFilePre, intFragePos - 1) And _

      Right$(strFilterPre, Len(strFilterPre) - intFragePos) = Right$(strFilePre, Len(strFilterPre) - intFragePos) Then

      booPre = True

   End If

   CheckFileName = booPre

End Function







'// +---------------------------------------------------------------------------

'// |

'// |    Abtrennen der Dateinamenserweiterung

'// |       liefert in strPre den Dateinamen von strFile und in strExt die

'// |       Dateinamenserweiterung

'// |

'// +---------------------------------------------------------------------------

Private Sub SplitFileName(ByVal strFile As String, ByRef strPre As String, ByRef strExt As String)

Dim intPos As Integer



   intPos = InStrRev(strFile, ".")

   If intPos > 0 Then

      strPre = Left$(strFile, intPos - 1)

      strExt = Right$(strFile, Len(strFile) - intPos)

   Else

      strPre = strFile

   End If

End Sub



 Code eingefügt mit Syntaxhighlighter 1.16














Gruß
Gaga

___________________________________________________________________

Profilösungen für VB6
wenn nicht anders angegeben, sind alle Codebeispiele nicht getestet, nur getippt


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: