Sito Comune - it.comp.appl.access

General

6.133 Creare una tabella contenente la struttura di un File System

La Sub che segue è un'evoluzione della Sub elencafile() pubblicata in questa Sezione del Sito Comune da Lorenzo Coronati nella FAQ intitolata "Creare una tabella contenente i nomi di file presenti in una directory".
Con quella Sub era possibile memorizzare in ua tabella solamente i nomi di tutti i file o di solo certi tipi di file contenuti in una directory.
Con la Sub pubblicata in questa FAQ è invece possibile:
1) Memorizzare in una tabella la struttura completa contenuta in una directory (nome della directory + nomi delle subdirectory in essa contebute + nomi dei file contenuti nella directory + nomi dei file contenuti nelle subdirectory).
2) Memorizzare in una tabella solo i nomi dei file contenuti in una directory e nelle sue eventuali subdirectory (ovvero quanto al punto 1) esclusi i nomi delle directori e subdirectori)
3) Memorizzare in una tabella solo i nomi delle directory e subdirectory contenute nel file System relativo di una directory (ovvero quanto al punto 1) esclusi i nomi dei file.
4) Memorizzare in una tabella solo i nomi dei file contenuti in una directory (ovvero quello che si otteneva con la Sub di Lorenzo Coronati)
5) Memorizzare in una tabella solo i nomi delle subdirectory contenuti in una directory.

Nella tabella verrà registrato un record per ogni directory/subdirectory e per ogni file conenuti nella directory selezionata.
La tabella è composta dai seguenti tre campi:
Percorso E' un campo di tipo Testo che rappresenta, per un record relativo ad un file il nome della sua directory (p.e. se il path completo di un file è C:\MiaCartella\MioFile.doc, in questo campo verrà memorizzato C:\MiaCartella\), mentre se il record è relativo ad una directory tale campo contiene il nome di detta directory.
NomeFile E' un campo di tipo Testo: risulta vuoto in un record relativo ad una directory, mentre in un record relativo ad un file contiene il nome del file e la sua extension (p.e. se il path completo di un file è C:\MiaCartella\MioFile.doc, in questo campo verrà memorizzato MioFile.doc).
Livello E' un campo di tipo Numerico che contiele il livello dell'oggetto nella gerarchia del File System; il record relativo alla directory scelta avrà livello 0 (zero), mentre i record relativi ai file ed alle subdirectory contenuti nella directory di livello 0 (zero) avranno livello1, invece i record relativi alle subdirectory ed ai file contenuti nelle subdirectory di livelli 1 avranno livello 2 e così via.

Di fatto nella tabella si memorizzerà la struttura ad albero del File System contenuto in una determinata directory.
Dalla maschera in cui si impostano i parametri che servono a creare e popolare la tabella (nome della direcory, tipo dei file da prendere in considerazione, ecc.) è possibile, pigiando un pulsante di comando, stampare la rappresentazione grafica di tale struttura ad albero.
E' possibile anche stampare una lista del contenuto della tabella dei soli record relativi ai file: tale lista è ordinata per nome file e da essa è possibile vedere se un file è contenuto nella directory più volte, nel qual caso in quali subdirectory.

Qui di seguito è mostrato il codice VBA dell sub che ottiene quanto sopra descritto:

' Sub che registra in una tabella la struttura di un File System
'
Public Sub ' Sub che registra in una tabella la struttura di un File System
'
Public Sub MemoFileSystem(Optional d As Variant, Optional j As String, Optional n As Integer)
'Argomenti:
' d=directory
' j=maschera di match (*.doc *.xls *.txt ecc.)
' n=tipo di dati da memorizzare
'   1 = struttura completa del File System
'   2 = solo i file del File System
'   3 = solo le directory del File System
'   4 = solo i file contenuti nella directory indicata
'   5 = solo le subdirectory contnute nella directory indicata
Dim Tabella As DAO.TableDef
Dim RstInput As DAO.Recordset
Dim RstOutput As DAO.Recordset
Dim s As String
Dim s1 As String
Dim Livello As Long
Dim strRecordset As String
Livello = 0
If Nz(d, "") = "" Then d = CurDir
If j = "" Then j = "*.*"
If Right(d, 1) <> "\" Then d = d & "\"
If n < 1 Or n > 5 Then n = 1
'Imposta il nome della tabella
s = "File System di " & d
If EsisteOggetto("Tabella", s) = True Then
    ' se la tabella già esiste, viene svuotata
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM [" & s & "];"
    DoCmd.SetWarnings True
Else
    ' se la tabella non esiste, viene creata
    Set Tabella = CurrentDb.CreateTableDef(s)
    Tabella.Fields.Append Tabella.CreateField("Percorso", dbText)
    Tabella.Fields.Append Tabella.CreateField("Livello", dbLong)
    Tabella.Fields.Append Tabella.CreateField("NomeFile", dbText)
    CurrentDb.TableDefs.Append Tabella
End If
' imposta il recordset che tratterà la tabella in registarzione
Set RstOutput = CurrentDb().OpenRecordset(s)
' registra nella tabella il record relativo alla directory
RstOutput.AddNew
RstOutput!Percorso = d
RstOutput!Livello = 0
RstOutput!NomeFile = Null
RstOutput.Update
' per ogni directory presente in tabella memorizza un record
' per ogni subdirectory in essa contenuta
Do Until 1 = 2
    ' imposta il recordset che tratterà la tabella in lettura;
    ' come si può vedere la stessa tabella verrà trattata
    ' contempraneamente con un recordset in lettura
    ' e con l'altro recordset in registrazione
    strRecordset = "(SELECT * FROM [" & s & "] WHERE Livello= " & Livello & " ;)"
    Set RstInput = CurrentDb().OpenRecordset(strRecordset)
    
    ' se il recordset è vuoto esci dal ciclo che scandisce le subdirectory
    If RstInput.RecordCount = 0 Then Exit Do
    
    RstInput.MoveFirst
    Do Until RstInput.EOF
        s1 = Dir(RstInput!Percorso, vbDirectory)
        Do While s1 <> ""
            ' Ignora la directory corrente e quella di livello superiore.
            If s1 <> "." And s1 <> ".." Then
                ' Usa il confronto bit per bit per verificare se s1 è una directory.
                If (GetAttr(RstInput!Percorso & s1) And vbDirectory) = vbDirectory Then
                    ' prepara e registra un record relativo alla subdirecory s1
                    RstOutput.AddNew
                    RstOutput!Percorso = RstInput!Percorso & s1 & "\"
                    RstOutput!Livello = Livello + 1
                    RstOutput.Update
                End If
            End If
            s1 = Dir
        Loop
        RstInput.MoveNext ' leggi il record successivo
    Loop
    Livello = Livello + 1
Loop
RstInput.Close
Set RstInput = Nothing
' reimposta il recordset per la lettura della tabella
strRecordset = "(SELECT * FROM [" & s & "] WHERE IsNull(NomeFile);)"
Set RstInput = CurrentDb().OpenRecordset(strRecordset)
' leggi il primo record
RstInput.MoveFirst
Do Until RstInput.EOF
    If Nz(RstInput!Percorso, "") <> "" Then
        ' determina il nome di un file contenuto nella directory
        ' il cui percorso è contenuto nel record corrente
        s1 = Dir(RstInput!Percorso & j)
        Do While s1 <> ""
            ' prepara e registra il record relativo al file s1
            RstOutput.AddNew
            RstOutput!NomeFile = s1
            RstOutput!Percorso = RstInput!Percorso
            RstOutput!Livello = RstInput!Livello + 1
            RstOutput.Update
            ' determina il nome di file successivo
            s1 = Dir
        Loop
    End If
    ' legi un altro record
    RstInput.MoveNext
Loop

Set Tabella = Nothing
Set RstInput = Nothing
Set RstOutput = Nothing

' la tabella contiene la struttura completa del File System;
' in base al valore dell'argomento n cancella dalla tabella
' i record che non si desidera mantenere memorizzati.
DoCmd.SetWarnings False
Select Case n
    Case 2
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE IsNull(NomeFile);"
    Case 3
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE Not IsNull(NomeFile);"
    Case 4
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE IsNull(NomeFile) Or Livello <> 1;"
    Case 5
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE ((Livello > 0) And (Not IsNull(NomeFile)) Or (Livello <> 1));"
End Select
DoCmd.SetWarnings True
End Sub
(Optional d As Variant, Optional j As String, Optional n As Integer)
'Argomenti:
' d=directory
' j=maschera di match (*.doc *.xls *.txt ecc.)
' n=tipo di dati da memorizzare
'   1 = struttura completa del File System
'   2 = solo i file del File System
'   3 = solo le directory del File System
'   4 = solo i file contenuti nella directory indicata
'   5 = solo le subdirectory contnute nella directory indicata
Dim Tabella As DAO.TableDef
Dim RstInput As DAO.Recordset
Dim RstOutput As DAO.Recordset
Dim s As String
Dim s1 As String
Dim Livello As Long
Dim strRecordset As String
Livello = 0
If Nz(d, "") = "" Then d = CurDir
If j = "" Then j = "*.*"
If Right(d, 1) <> "\" Then d = d & "\"
If n < 1 Or n > 5 Then n = 1
'Imposta il nome della tabella
s = "File System di " & d
If EsisteOggetto("Tabella", s) = True Then
    ' se la tabella già esiste, viene svuotata
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM [" & s & "];"
    DoCmd.SetWarnings True
Else
    ' se la tabella non esiste, viene creata
    Set Tabella = CurrentDb.CreateTableDef(s)
    Tabella.Fields.Append Tabella.CreateField("Percorso", dbText)
    Tabella.Fields.Append Tabella.CreateField("Livello", dbLong)
    Tabella.Fields.Append Tabella.CreateField("NomeFile", dbText)
    CurrentDb.TableDefs.Append Tabella
End If
' imposta il recordset che tratterà la tabella in registarzione
Set RstOutput = CurrentDb().OpenRecordset(s)
' registra nella tabella il record relativo alla directory
RstOutput.AddNew
RstOutput!Percorso = d
RstOutput!Livello = 0
RstOutput!NomeFile = Null
RstOutput.Update
' per ogni directory presente in tabella memorizza un record
' per ogni subdirectory in essa contenuta
Do Until 1 = 2
    ' imposta il recordset che tratterà la tabella in lettura;
    ' come si può vedere la stessa tabella verrà trattata
    ' contempraneamente con un recordset in lettura
    ' e con l'altro recordset in registrazione
    strRecordset = "(SELECT * FROM [" & s & "] WHERE Livello= " & Livello & " ;)"
    Set RstInput = CurrentDb().OpenRecordset(strRecordset)
    
    ' se il recordset è vuoto esci dal ciclo che scandisce le subdirectory
    If RstInput.RecordCount = 0 Then Exit Do
    
    RstInput.MoveFirst
    Do Until RstInput.EOF
        s1 = Dir(RstInput!Percorso, vbDirectory)
        Do While s1 <> ""
            ' Ignora la directory corrente e quella di livello superiore.
            If s1 <> "." And s1 <> ".." Then
                ' Usa il confronto bit per bit per verificare se s1 è una directory.
                If (GetAttr(RstInput!Percorso & s1) And vbDirectory) = vbDirectory Then
                    ' prepara e registra un record relativo alla subdirecory s1
                    RstOutput.AddNew
                    RstOutput!Percorso = RstInput!Percorso & s1 & "\"
                    RstOutput!Livello = Livello + 1
                    RstOutput.Update
                End If
            End If
            s1 = Dir
        Loop
        RstInput.MoveNext ' leggi il record successivo
    Loop
    Livello = Livello + 1
Loop
RstInput.Close
Set RstInput = Nothing
' reimposta il recordset per la lettura della tabella
strRecordset = "(SELECT * FROM [" & s & "] WHERE IsNull(NomeFile);)"
Set RstInput = CurrentDb().OpenRecordset(strRecordset)
' leggi il primo record
RstInput.MoveFirst
Do Until RstInput.EOF
    If Nz(RstInput!Percorso, "") <> "" Then
        ' determina il nome di un file contenuto nella directory
        ' il cui percorso è contenuto nel record corrente
        s1 = Dir(RstInput!Percorso & j)
        Do While s1 <> ""
            ' prepara e registra il record relativo al file s1
            RstOutput.AddNew
            RstOutput!NomeFile = s1
            RstOutput!Percorso = RstInput!Percorso
            RstOutput!Livello = RstInput!Livello + 1
            RstOutput.Update
            ' determina il nome di file successivo
            s1 = Dir
        Loop
    End If
    ' legi un altro record
    RstInput.MoveNext
Loop

Set Tabella = Nothing
Set RstInput = Nothing
Set RstOutput = Nothing

' la tabella contiene la struttura completa del File System;
' in base al valore dell'argomento n cancella dalla tabella
' i record che non si desidera mantenere memorizzati.
DoCmd.SetWarnings False
Select Case n
    Case 2
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE IsNull(NomeFile);"
    Case 3
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE Not IsNull(NomeFile);"
    Case 4
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE IsNull(NomeFile) Or Livello <> 1;"
    Case 5
        DoCmd.RunSQL "Delete * FROM [" & s & "] WHERE ((Livello > 0) And (Not IsNull(NomeFile)) Or (Livello <> 1));"
End Select
DoCmd.SetWarnings True
End Sub

Nella Sub MemoFileSystem di cui sopra si fa riferimento alla funzione EsisteOggetto() già documentata in un'altra FAQ del Sito Comune e che per comodità del lettore riportiamo anche qui di seguito:

'Funzione che verifica l'esistenza di un determinato oggetto nel
'         database corrente.
'
Function EsisteOggetto(TipoOggetto As String, NomeOggetto As String) As Integer
'
'TipoOggetto stringa che può assumere il valore "Tabella", o "Query",
'            o "Maschera", o "Modulo", o "Report" oppure "Macro"
'
'NomeOggetto è una stringa che contiene il nome dell'oggetto di cui si
'            vuole verifivare l'esistenza ne database corrente
'
' la funzione ritorna il valore True o False

On Error Resume Next
Dim OggettoTrovato As Integer, CercaOggetto As String, NumOggetto As Integer
Dim db As DAO.Database, t As DAO.TableDef
Dim Q As DAO.QueryDef, C  As DAO.Container
Dim msg As String
OggettoTrovato = False
Set db = CurrentDb()
Select Case TipoOggetto
Case "Tabella"
    CercaOggetto = db.TableDefs(NomeOggetto).Name
Case "Query"
    CercaOggetto = db.QueryDefs(NomeOggetto).Name
Case Else
    If TipoOggetto = "Maschera" Then
        NumOggetto = 1
    ElseIf TipoOggetto = "Modulo" Then
        NumOggetto = 2
    ElseIf TipoOggetto = "Report" Then
        NumOggetto = 4
    ElseIf TipoOggetto = "Macro" Then
        NumOggetto = 5
    Else
        msg = "Il nome oggetto """ & TipoOggetto & """ non è un valido"
        msg = msg & " argomento per la funzione EsisteOggetto!"
        MsgBox msg, 16, "Funzione EsisteOggetto"
        Exit Function
    End If
    Set C = db.Containers(NumOggetto)
    CercaOggetto = C.Documents(NomeOggetto).Name
End Select
If Err = 3265 Or CercaOggetto = "" Then
    OggettoTrovato = False
Else
    OggettoTrovato = True
End If
    EsisteOggetto = OggettoTrovato
End Function

Anche il codice VBA di questa Sub va memorizzato in un modulo del database.

Qui di seguito c'è un esempio di come richiamare la sub nel caso in cui si voglia memorizzare nella tabella sia i nomi delle subdirectory che i nomi dei file Word in esse contenuti:

Dim NomeDirecory As String
Dim TipoFile As String
NomeDirectory = "C:\MiaCartella"
TipoFile = "*.doc"
Call MemoFileSystem(NomeDirectory, TipoFile,1)

NB
Nella Sub MemoFileSystem di cui sopra si fa riferimento alla libreria Microoft DAO quindi, se si usa una versione di Access successiva ad Access 97, occorre aggiungere tale libreria ai riferimenti del dataBase.
La formattazione del report che disegna la struttura ad albero del File System è abbastanza complessa; durante lo svolgimento dell'elaborazione comparirà sul video la clessidra e sarà possibile seguire l'attuazione della formattazione con la barra di progressione posta nella barra di stato di Access, che si trova nella parte in basso a sinistra del video.

Download:

FileDirSubdir.zip (64Kb) MSAccess97 database

Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.