Search  

   

Latest News  

Problemstellung:Wenn man Etiketten drucken will steht man oft vor einigen Problemen.1. Man möchte nur ein paar Etiketten drucken und beim nächsten Druck braucht man wieder   ein neues Blatt weil freie...
   

Latest Forumposts  

  • Keine Beiträge vorhanden
   

Kommentare  

Tut mir leid Hella, ich kann Dir nicht folgen? 13.04.2017 - 14.04.2017 ergibt bei mir 1 13.04.2017 -...
Gast - Hella
Hallo, Berechne wie folgt, ob "zu früh" oder "zu spät" Rückmeldet. Früher sollte auch mit negativer ...
Gast - Hella
Hallo, mit negativen Werten meine ich z.B. -5 Tage (ohne Wochenende) u.ä. Zur Zeit wird nur die 0 au...
Hallo Hella, wie negative Werte? Kannst Du es erläutern was Du machen willst? Gruß Tommy
Gast - Hella
Hallo, ich bräuchte auch negative Werte bei der Anzahl, wie kann man das realisieren? Liebe Grüße He...
   

Counter  

1114564
HeuteHeute163
GesternGestern1132
Diese WocheDiese Woche1295
Dieser MonatDieser Monat22776
GesamtGesamt1114564
Highest 07.12.2017 : 1250
US
UNITED STATES
US

This page uses the IP-to-Country Database provided by WebHosting.Info (http://www.webhosting.info), available from http://ip-to-country.webhosting.info

   

Download Statistik  

Diese Site enthält 187 Downloads in 30 Kategorien. Gesamtdownloads bisher: 234295
   
Free live stats and visitor counter for Joomla, Wordpress, Drupal, Magento and Prestashop
   

Login

   

User Online

Total: 78 Members: 0 Guests: 78
No members online
   

Beiträge

Einlesen von Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank

Bewertung:  / 0
SchwachSuper 
Details

Problemstellung:

Wie man Dateien in eine MS-Access DB einlesen kann hatte ich schon in
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 unter A00-A10 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.

Option Explicit
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
Private Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    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)
 

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
 
Im Formular sieht dann der Aufruf der Sub so aus:
Private Sub cmd_Folder_Click()
    Dim sFolder As String
    Dim sFilter As String
    'Tabelle leeren
    CurrentDb.Execute "DELETE tbl_Files.LNR FROM tbl_Files;"
    Me.lst_Files.Requery
    'Verzeichnis öffnen
    sFolder = GetDirectory("Bitte wählen Sie einen Ordner")
    If IsNull(sFolder) Or sFolder = "" Then Exit Sub
    'Dateifilter prüfen
    If IsNull(Me.txt_Filter) Then
        sFilter = "*.*"
    Else
        sFilter = Me.txt_Filter
    End If
    'Dateien einlesen
    Call ReadFolder(sFolder, sFilter, Me.chk_SubFolder, Me.txt_OT)
    'Aktualisierung des Listenfeldes
    Me.lst_Files.Requery
End Sub
Der vereinfachte Aufruf kann dann auch z.B. so aussehen:
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:
Einlesen von Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank v.1.0

Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank

Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank
A2 - A10

Die RAR-Datei enthält eine Version ab A2000
Datum 08.10.2012 Dateigröße 23.68 KB Download 600

Einen Kommentar verfassen

Als Gast kommentieren

0 / 300 Zeichen Beschränkung
Dein Text sollte zwischen 10-300 Zeichen lang sein
Nutzungsbedingungen.
  • Keine Kommentare gefunden