Newsgroup: it.comp.appl.access
Titolo: Elencare file e cartelle.

In A2010 devo scorrere tutti i file contenuti in una cartella e le sue
sottocartelle. Ho provato le funzioni Dir e ChDir ma non mi ci raccapezzo.
Lo schema da seguire č:
-elenco i file
-scendo alla prima sottocartella e rielenco
-cosě via fino all'ultimo livello
-torno su di un livello e scendo alla seconda sottocartella
I file trovati devono essere rinominati/spostati/elencati.
Confesso che sono senza idee; ho provato a cercare in giro ma non ho
trovato suggerimenti adatti al mio caso specifico, qualcuno ha un'idea?
Grazie a tutti.
 
 
-- 
Riccardo Baldinotti
http://riccardobaldinotti.wordpress.com
 
http://rikky.netii.net
 
 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it
 
 
 

 Grazie a tutti.
 
Dovrei riscriverlo per accorciarlo un po' ma non ne ho voglia.
Creati una tabella di nome AAA, con un campo di nome FileName
ed esegui da un CommandButton:
LoadFromFolder "C:\XYZ\", "AAA", "FileName"
==============================================================
Public Sub LoadFromFolder( _
           FolderSpec As String, _
           TableName As String, _
           FieldName As String, _
           Optional ClearTable As Boolean = True, _
           Optional Pattern As String = "*", _
           Optional CompleteWithPath As Boolean = False, _
           Optional AllowDuplicates As Boolean = True, _
           Optional IncludeSubDirs As Boolean = True)
 
' 27-02-02
' FolderSpec può essere dato nei formati:
' J:, J:\, J:\Eizo, J:\Eizo\
'
' Il riferimento a tutti i file deve esprimersi con "*"; se espresso 
con "*.*"
' verranno esclusi i file che non hanno estensione.
'
' Funziona anche con FolderSpec = percorso di rete
'
DoCmd.Hourglass True
 
Dim FS As New FileSystemObject, FS_subFolders As Object
Dim FS_Folders As Object, FS_Files As Object
Dim colFolders_1 As New Collection, colFolders_2 As Collection
Dim i, j, k, z As Long, FileNameOnly As String
Dim TextToWrite As String, Criterio As String
Dim db As Database, RS As Recordset
 
Set db = CurrentDb
If ClearTable Then
    db.Execute "DELETE " & TableName & ".* FROM " & TableName & ";"
End If
Set RS = db.OpenRecordset(TableName, dbOpenDynaset)
 
colFolders_1.Add FolderSpec
On Error GoTo FolderNotFound
Set FS_Folders = FS.GetFolder(FolderSpec)
On Error GoTo 0
Set FS_Files = FS_Folders.Files
 
For Each k In FS_Files
    GoSub WriteTable
Next
If Not IncludeSubDirs Then
    GoTo Exit_Sub
End If
 
Inizia:
'------
Set colFolders_2 = colFolders_1
Set colFolders_1 = New Collection
For Each i In colFolders_2
    Set FS_Folders = FS.GetFolder(i)
    Set FS_subFolders = FS_Folders.SubFolders
    For Each j In FS_subFolders
        Set FS_Folders = FS.GetFolder(j.path)
        colFolders_1.Add j.path
        Set FS_Files = FS_Folders.Files
        For Each k In FS_Files
            GoSub WriteTable
        Next k
    Next j
Next i
If colFolders_1.Count > 0 Then
    GoTo Inizia
End If
 
Exit_Sub:
    DoCmd.Hourglass False
    Exit Sub
 
WriteTable:
'----------
FileNameOnly = Mid(k, InStrRev(k, "\", -1) + 1)
If CompleteWithPath Then
    TextToWrite = k
Else
    TextToWrite = FileNameOnly
End If
If FileNameOnly Like Pattern Then
    If Not AllowDuplicates Then
        Criterio = "[" & FieldName & "]= " & Chr(34) & TextToWrite & 
Chr(34)
        On Error GoTo LoadFromFolder_Err
        RS.FindFirst Criterio
        On Error GoTo 0
        If Not RS.NoMatch Then
            Return
        End If
    End If
    RS.AddNew
    RS(FieldName) = TextToWrite
    RS.Update
Else
    MsgBox TextToWrite
End If
Return
 
LoadFromFolder_Err:
'------------------
    MsgBox "Err. " & Err.Number & "  -  " & Err.Description & vbCrLf & 
TextToWrite
    Resume Exit_Sub
 
FolderNotFound:
    MsgBox "Err. " & Err.Number & "  -  " & Err.Description & vbCrLf & 
vbLf & _
           "Folder:  " & UCase(FolderSpec) & "  --  non trovato."
    Resume Exit_Sub
 
End Sub
===================================================
 
Bruno
 
 

 Bruno
 
 
Grazie, comincio a giocarci!
