Leggere i files con Dir e Open

Ultima modifica: 27-05-2016

In questa pagina vedremo in modo semplice alcune tecniche per leggere i files che sono in una determinata cartella (quella in cui risiede il file Excel che stiamo usando).

Queste le procedure che vedremo:

  1. Leggere tutti i files della cartella
  2. Leggere i files usando un filtro (xls)
  3. Leggere i files usando ancora un filtro (txt)
  4. Leggere il contenuto dei files di testo (usando il filtro txt) e visualizzarne il contenuto
Attenzione: in tutte le routines qui sotto descritte c'è una istruzione:
Columns("A:G").ClearContents
Questo per cancellare le colonne dalla A alla G che potrebbero contenere dati inseriti dall'ultima routines anche se le altre routines usano una sola colonna.

Prima procedura: leggere tutti i files

Determino la cartella in cui debbo leggere: Percorso = ActiveWorkbook.Path & "\" che nel nostro caso restituisce C:\documenti\excel.

Aiutati dalla funzione Dir() leggo tutti i files e li visualizzo nel foglio attivo e dall'istruzione Do While continuo a leggere nella cartella indicata

Sub Leggi_Files()
Dim Percorso, Riga, Colonna
Dim MioNome
Columns("A:G").ClearContents
Percorso = ActiveWorkbook.Path & "\"
Colonna = 1
MioNome = Dir(Percorso)
Do While MioNome <> ""
Riga = Riga + 1
Cells(Riga, Colonna) = MioNome
MioNome = Dir()
Loop
End Sub

Seconda procedura: leggere i files filtrati tramite l'estensione xls

Per far questo uso la sintassi Dir(Percorso & Ext) che mi restituisce: C:\documenti\excel\*.xls

Sub leggi_con_filtro()
Dim Percorso, Riga, Colonna, Ext
Dim NomeFile
Ext = "xls"
Percorso = ActiveWorkbook.Path
Colonna = 1
Columns("A:G").ClearContents
If Left(Ext, 1) <> "*" Then
Ext = "*." & Ext
End If
If Right(Percorso, 1) <> "\" Then
Percorso = Percorso & "\"
End If
NomeFile = Dir(Percorso & Ext)
Do While NomeFile <> ""
Riga = Riga + 1
Cells(Riga, Colonna) = NomeFile
NomeFile = Dir()
Loop
End Sub

Terza procedura: leggere i dati filtrati sull'aestensione txt

Questa è simile alla precedente, ma anzichè leggere i files xls legge quelli con esntesione txt

Sub Leggi_filtro_txt()
Dim Percorso, Riga, Colonna, Ext
Dim NomeFile
Ext = "txt"
Percorso = ActiveWorkbook.Path
Colonna = 1
Columns("A:G").ClearContents
If Left(Ext, 1) <> "*" Then
Ext = "*." & Ext
End If
If Right(Percorso, 1) <> "\" Then
Percorso = Percorso & "\"
End If
NomeFile = Dir(Percorso & Ext)
Do While NomeFile <> ""
Riga = Riga + 1
Cells(Riga, Colonna) = NomeFile
NomeFile = Dir()
Loop
End Sub

Quarta procedura: lettura dei files di testo presenti nella cartella in cui risiede il file Excel e degli attributi dei files

Ora combino la lettura dei files TXT dalla cartella con la lettura del loro contenuto. Dopo aver raccolto i files letti in una matrice li passo in rassegna in un ciclo FOR. Oltre alla lettura del contenuto dei files di testo ne leggeremo anche alcuni attributi aiutati dalle Funzioni VBA GetAttr, FileDateTime, FileLen

Per la lettura del file, fra i tanti metodi uso l'istruzione Input$(LOF(FileNum), #FileNum) per leggere tutto il file in una unica stringa. Si sarebbe potuto scegliere qualcuno degli altri metodi, ma il risultato sarebbe stato lo stesso.

Una volta letti i files si passa alla funzione personale che analizza il file e ne restituisce alcune proprietà.

Sub Leggi_contenuto_txt()
Dim Percorso, Riga, Colonna, RC, Ext
Dim NomeFile, FileNum, S, S1
Dim Lista()
Ext = "txt"
Percorso = ActiveWorkbook.Path
Colonna = 1
Columns("A:G").ClearContents
If Left(Ext, 1) <> "*" Then
Ext = "*." & Ext
End If
If Right(Percorso, 1) <> "\" Then
Percorso = Percorso & "\"
End If
NomeFile = Dir(Percorso & Ext)
Do While NomeFile <> ""
Riga = Riga + 1
ReDim Preserve Lista(1 To Riga) ' raccolgo in una matrice dinamica i files letti
Lista(Riga) = NomeFile
NomeFile = Dir()
Loop
For Riga = 1 To UBound(Lista)
FileNum = FreeFile
Open Percorso & Lista(Riga) For Input As #FileNum
Cells(Riga, 1) = Input$(LOF(FileNum), #FileNum) ' vengono letti tutti i caratteri in una sola volta
' se non si ha intenzione si usare questa funzione basta commentarla o cancellarla
Call Attributes(Percorso & Lista(Riga), Riga, 2) ' qui viene chiamata la funzione che indicherò qui sotto e che visualizza alcuni attributi del file che si sta leggendo
Close #FileNum
Next
End Sub

Quinta procedura: lettura dei files e relativi metadata tramite il FileSystem

Questo è un po' più complesso della procedura precedente perchè stavolta, per leggere gi attributi dei files usiamo il FileSystemObject con alcuni dei suoi metodi.

Oltre che leggere i files dalla nostra solita cartella, C:\documenti\excel, ne legge anche i relativi attributi scritti nei loro metadati. I metadati sono un componente prezioso per i file che descrivono varie proprietà e attributi del file, quali: Path, File, Name, Last Accessed, Last Modified, Created, Type, Size, Owner, Author, Title, Comments.

Per fare questo, si può ricorrere al FileSystemObject (FSO) che è uno strumento basato sugli oggetti per l'utilizzo di cartelle e file. Oltre alla manipolazione di files e cartelle permette anche di leggere varie informazioni dalle cartelle e dai files che si intende esaminare. Ed è questo quel che faremo in questa routine.

Questa la routine (abbastanza commentata):

Sub Leggi_Attibuti()
Dim Attributes()
Dim i As Long
Dim objShell, objFolder, objFolderItem
Dim FSO, oFolder, Fil
Dim Folder As String
ReDim Attributes(1 To 65536, 1 To 11)
' preparo l'ambiente per avere l'accesso a tutti i files
Set objShell = CreateObject("Shell.Application")
Application.ScreenUpdating = False
' cerco la cartella del disco rigido
Folder = ActiveWorkbook.Path
' le informazioni raccolte verranno scritte sul Foglio2
Sheets("Foglio2").Select
Columns("A:K").ClearContents
' questa matrice raccoglierà tutte le informazioni dai files letti nella cartella indicata
' intanto memorizzo le intestazioni di colonna

Attributes(1, 1) = "Path"
Attributes(1, 2) = "File Name"
Attributes(1, 3) = "Last Accessed"
Attributes(1, 4) = "Last Modified"
Attributes(1, 5) = "Created"
Attributes(1, 6) = "Type"
Attributes(1, 7) = "Size"
Attributes(1, 8) = "Owner"
Attributes(1, 9) = "Author"
Attributes(1, 10) = "Title"
Attributes(1, 11) = "Comments"
i = 1
' continua la preparazione dell'ambiente per la gestione degli oggetti
Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(Folder)
On Error Resume Next
' in oFolder.Files ho tutti i files della cartella
' e nel successivo ciclo leggo gli attributi dei files man mano che li scorro

For Each Fil In oFolder.Files
Set objFolder = objShell.Namespace(oFolder.Path)
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
Attributes(i, 1) = oFolder.Path
Attributes(i, 2) = Fil.Name
Attributes(i, 3) = Fil.DateLastAccessed
Attributes(i, 4) = Fil.DateLastModified
Attributes(i, 5) = Fil.DateCreated
Attributes(i, 6) = Fil.Type
Attributes(i, 7) = Fil.Size
Attributes(i, 8) = objFolder.GetDetailsOf(objFolderItem, 8)
Attributes(i, 9) = objFolder.GetDetailsOf(objFolderItem, 9)
Attributes(i, 10) = objFolder.GetDetailsOf(objFolderItem, 10)
Attributes(i, 11) = objFolder.GetDetailsOf(objFolderItem, 14)
Next
' finita la raccolta delle informazioni si passa sul foglio con la scrittura del contenuto della matrice
Range("A:K") = Attributes
Range("A:K").WrapText = False
Range("A:K").EntireColumn.AutoFit
Range("1:1").Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("a1").Activate
' si comincia a distruggere gli oggetti creati precedentemente preparati per liberare la memoria
Set FSO = Nothing
Set objShell = Nothing
Set oFolder = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set Fil = Nothing
Application.ScreenUpdating = True
End Sub

Questo è un possibile risultato di quanto viene restituito dalla routine qui sopra:

Path File Name Last Accessed Last Modified Created Type Size Owner Category Title Comments
C:\documenti\excel 010441281.xlsm 05/01/2013 01:13 03/11/2012 17:34 05/01/2013 01:13 Foglio con attivazione macro di Microsoft Excel 27876 Documento MY-PC  
C:\documenti\excel a_prova.xlsx 05/01/2013 01:20 05/01/2013 01:20 05/01/2013 01:20 Foglio di lavoro di Microsoft Excel 8718 Documento MY-PC  
C:\documenti\excel eliminare_righe_e_colonne.xls 17/10/2012 02:19 17/10/2012 02:19 16/10/2012 19:15 Foglio di lavoro di Microsoft Excel 97-2003 65024 Documento MY-PC  
C:\documenti\excel immagine_logo.jpg 06/01/2013 23:51 06/02/2008 12:22 06/01/2013 23:51 File JPG 12558 Immagine MY-PC  
C:\documenti\excel indirizzo.txt 04/01/2013 19:46 04/01/2013 19:46 04/01/2013 19:46 Documento di testo 70 Testo MY-PC  
C:\documenti\excel lettura_files_simplex.xls 06/01/2013 19:17 06/01/2013 23:16 03/01/2013 00:44 Foglio di lavoro di Microsoft Excel 97-2003 73728 Documento MY-PC  
C:\documenti\excel libro.GIF 06/01/2013 23:51 20/06/2007 11:41 06/01/2013 23:51 File GIF 279 Immagine MY-PC  
C:\documenti\excel ordinamento_in_base_piu_campi.xls 15/10/2012 22:29 15/10/2012 22:29 29/01/2006 09:29 Foglio di lavoro di Microsoft Excel 97-2003 68096 Documento MY-PC  
C:\documenti\excel prova_1.txt 03/01/2013 01:05 03/01/2013 01:16 03/01/2013 01:05 Documento di testo 7 Testo MY-PC  
C:\documenti\excel prova_2.txt 03/01/2013 01:15 03/01/2013 01:16 03/01/2013 01:15 Documento di testo 7 Testo MY-PC  
C:\documenti\excel prova_3.txt 03/01/2013 10:35 03/01/2013 10:35 03/01/2013 10:35 Documento di testo 33 Testo MY-PC  
C:\documenti\excel verde.jpg 06/01/2013 23:52 23/11/2006 00:06 06/01/2013 23:52 File JPG 773 Immagine MY-PC  

 

 

La funzione personale per leggere gli attibuti del file

In questa funzione:

con GetAttr vedo il tipo di oggetto che sto leggendo e che è elencato nel costrutto Select Case

con FileDateTime ottengo la data e l'ora di creazione o dell'ultima modifica di un file

con FileLen ottengo la dimensione del file in bytes

con Mid(File_Name, InStrRev(File_Name, ".") + 1) si ottiene l'estensione dei files

Per usare questa funzione occorre usare, come si vede dalla macro qui sopra, questa istruzione:

Call Attributes(Percorso & Lista(Riga), Riga, 2)

dove:

Public Function Attributes(File_Name, R, C)
Dim S
S = GetAttr(File_Name)
Select Case S
Case 0
Cells(R, C) = "0 - Normale"
Case 1
Cells(R, C) = "1 - Sola lettura"
Case 2
Cells(R, C) = "2 - Nascosto"
Case 4
Cells(R, C) = "4 - File di sistema"
Case 8
Cells(R, C) = "8 - volume dell'unità disco"
Case 16
Cells(R, C) = "16 - Directory o cartella"
Case 32
Cells(R, C) = "32 - Attributo del file = Archivio"
Case 64
Cells(R, C) = "64 - Attributo del file = Collegamento"
Case 128
Cells(R, C) = "128 - Attributo del file = Compresso"
End Select
Cells(R, C + 1) = FileDateTime(File_Name)
Cells(R, C + 2) = FileLen(File_Name) & " bytes"
Cells(R, C + 3) = Mid(File_Name, InStrRev(File_Name, ".") + 1)
End Function

La terza routine assieme a questa funzione restituisce qualcosa del genere:

Nome file Contenuto file Attributo del file Data Ultima Modifica o creazione file Dimensione file Ext file
prova_1.txt prova 1 32 - Attributo del file = Archivio 03/01/2013 01:16 7 bytes txt
prova_2.txt prova 2 32 - Attributo del file = Archivio 03/01/2013 01:16 7 bytes txt
prova_3.txt prova 3
questa è la seconda riga
32 - Attributo del file = Archivio 03/01/2013 10:35 33 bytes txt