Zufälliger Artikel

Problemstellung:

Wie kann ich messen wie lange ein Abfrage dauert?

Folgenden Code in öffentliches Modul kopieren:

Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Function TimeShows(sAbfrage As String)
    Dim nStart As Long
    Dim nEnd As Long
    nStart = GetTickCount()
    DoCmd.OpenQuery sAbfrage
    nEnd = GetTickCount()
    TimeShows = CStr((nEnd - nStart) / 1000)
End Function

Aufruf z.B.:

MsgBox TimeShows("Abfrage1")

Ähnliche Artikel

Home

1 1 1 1 1 1 1 1 1 1 Rating 0.00 (0 Votes)

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 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)
 

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:

Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank

ab A00

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

Ähnliche Artikel

Kommentar schreiben

Sicherheitscode
Aktualisieren

Login Form

1.png1.png9.png1.png6.png6.png7.png
Heute1
Gestern84
Diese Woche224
Dieser Monat1600
Total1191667

  • IP: 54.161.45.156
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

1
Online

26. April 2018