Problemstellung:
Nur für 32Bit Office Versionen
Wie man Dateien in eine MS-Access DB einlesen kann hatte ich schon in
2 verschiedenen Lösungen gezeigt.
2 verschiedenen Lösungen gezeigt.
Jetzt kam aber die Frage auf wie man die Suchroutine dahin gehend ändern kann, dass nur
bis zu einer bestimmten Ordnertiefe suchen kann?
Die Lösung dafür möchte ich hier vorstellen.
Voraussetzungen:
Das Bsp ist ab A00 lauffähig.
Funktionsweise:
In der Bsp-DB befinden sich ein Klassenmodul und 2 Module.
Auf die Erklärung der 2 Module verzichte ich, denn diese dürften selbst erklärend sein.
Kernstück ist das Klassenmodul "cls_ListFiles". Damit wird die Dateistruktur in eine Collection eingelesen.
Public Col_File As Collection Public Function ListFiles(strPath As String, Optional strFileSpec As String, _ Optional bIncludeSubfolders As Boolean) On Error GoTo Err_Handler Dim colDirList As New Collection Dim temp_col As New Collection Dim varItem As Variant Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders) For Each varItem In colDirList temp_col.Add varItem Next Set Col_File = temp_col Exit_Handler: Exit Function Err_Handler: MsgBox "Error " & Err.Number & ": " & Err.Description Resume Exit_Handler End Function Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _ bIncludeSubfolders As Boolean) Dim strTemp As String Dim colFolders As New Collection Dim vFolderName As Variant strFolder = TrailingSlash(strFolder) strTemp = Dir(strFolder & strFileSpec) Do While strTemp <> vbNullString colDirList.Add strFolder & strTemp strTemp = Dir Loop If bIncludeSubfolders Then strTemp = Dir(strFolder, vbDirectory) Do While strTemp <> vbNullString If (strTemp <> ".") And (strTemp <> "..") Then If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then colFolders.Add strTemp End If End If strTemp = Dir Loop For Each vFolderName In colFolders Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True) Next vFolderName End If End Function
Diese Klasse wird dann in der Sub "ReadFolder" im Formular aufgerufen.
Die Sub erwartet 4 Parameter:
1. strFolder = Sartverzeichnis
2. strFilter = den Dateifilter
3. bSubfolder = mit oder ohne Unterverzeichnisse (Optional, Standardwert = Falsch)
4. iDepth = die Ordnertiefe (Optional, Standardwert = 0, alle Unterverzeichnisse)
2. strFilter = den Dateifilter
3. bSubfolder = mit oder ohne Unterverzeichnisse (Optional, Standardwert = Falsch)
4. iDepth = die Ordnertiefe (Optional, Standardwert = 0, alle Unterverzeichnisse)
Hinweis:
Ist bSubfolder=False wird der Parameter iDepth ignoriert.
Dim cLFs As New cls_ListFiles Private Sub ReadFolder(strFolder As String, strFilter As String, Optional bSubfolder As Boolean = False, _ Optional iDepth As Integer = 0) Dim x Dim i As Long, nCount As Long Dim rs As DAO.Recordset, db As DAO.Database Dim tSplitPath As SplitPath Dim iLen As Integer, sTemp As String, iCountSign As Integer On Error GoTo Folder_Error Set db = CurrentDb nCount = 0 'Klasse zum Einlesen der Dateien aufrufen x = cLFs.ListFiles(strFolder, strFilter, bSubfolder) ' Anzahl der gefunden Dateien anzeigen If iDepth = 0 Then Me.lbl_CountFiles.Caption = cLFs.Col_File.Count _ & " Dateien nach den Kriterien gefunden" Set rs = db.OpenRecordset("tbl_Files", dbOpenDynaset) DoCmd.Echo False, "Bitte warten..., die Tabelle 'Files' wird mit Daten gefüllt" 'Länge des Startverzeichnisses ermitteln iLen = Len(strFolder) For i = 1 To cLFs.Col_File.Count If iDepth = 0 Then 'Keine Beschränkung der Ordnertiefe rs.AddNew rs("Datei") = cLFs.Col_File(i) rs("Dateigrösse") = FileLen(cLFs.Col_File(i)) rs("Dateidatum") = FileDateTime(cLFs.Col_File(i)) tSplitPath = fileSplit(cLFs.Col_File(i)) rs("Pathname") = tSplitPath.sDrive & tSplitPath.sPath rs("Filename") = tSplitPath.sFile rs.Update DoEvents Else '******************************************* 'Prüfen der erreichten Ordnertiefe sTemp = Mid(cLFs.Col_File(i), iLen + 1) iCountSign = CountSign(sTemp, "\") '******************************************* If iCountSign <= iDepth Then 'Vergleich Soll und IST Ordertiefe rs.AddNew rs("Datei") = cLFs.Col_File(i) rs("Dateigrösse") = FileLen(cLFs.Col_File(i)) rs("Dateidatum") = FileDateTime(cLFs.Col_File(i)) tSplitPath = fileSplit(cLFs.Col_File(i)) rs("Pathname") = tSplitPath.sDrive & tSplitPath.sPath rs("Filename") = tSplitPath.sFile rs.Update 'Anzahl der Dateien nCount = nCount + 1 DoEvents End If End If Next i ' Anzahl der gefunden Dateien anzeigen If iDepth <> 0 Then Me.lbl_CountFiles.Caption = nCount & " Dateien nach den Kriterien gefunden" DoCmd.Echo True rs.Close db.Close On Error GoTo 0 Exit Sub Folder_Error: Resume Next End Sub
Call ReadFolder("E:\Eigene Dateien\Access", "*.mdb", True, 2)
Hier würden alle MDB-Dateien aus dem Verzeichnis "E:\Eigene Dateien\Access" mit Unterverzeichnissen bis 2 Ebenen unter dem Startverzeichnis eingelesen.
Dateien:
Nur für 32Bit Office Versionen
Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank
ab A00
Die RAR-Datei enthält eine Version ab A00
Ähnliche Artikel
Weiterlesen...