Newsgroup: it.comp.lang.visual-basic
Titolo: Scansione HDD con sottocartelle

Ciao a tutti,
ho fatto una procedura per scansionare tutti i file di un HDD, ma mi si
ferma al primo livello di cartelle.
Avete qualche consiglio?
Grazie
Ecco il codice utilizzato:
------------------------------------------------
Private Sub Command1_Click()
 Dim sDirectory As String
 Dim sSubDirectory As String
 Dim Pos As Integer
 Dim favFolder As String
 Dim PrintFile As String
 
 On Error GoTo Errore
 
 favFolder = "C:" 'Directory di partenza
 
 Open "C:\lista.txt" For Output As #1
 Open "C:\errori.txt" For Output As #2
 
 Call CercaFile(favFolder & "\") 'Procedura che ricerca tutti i file
contenuti nella directry di partenza
 
 sDirectory = Dir(favFolder & "\", vbNormal Or vbHidden Or vbReadOnly Or
vbSystem Or vbDirectory)
 Do While sDirectory <> ""
  PrintFile = favFolder & "\" & sDirectory
  If sDirectory <> "." And sDirectory <> ".." And Right(UCase(sDirectory),
4) <> ".SYS" Then
    If (GetAttr(favFolder & "\" & sDirectory) And vbDirectory) =
vbDirectory Then
      Print #1, PrintFile
      sSubDirectory = Dir(favFolder & "\" & sDirectory & "\", vbNormal Or
vbHidden Or vbReadOnly Or vbSystem Or vbDirectory)
      Do While sSubDirectory <> ""
        PrintFile = favFolder & "\" & sDirectory & "\" & sSubDirectory
        If sSubDirectory <> "." And sSubDirectory <> ".." Then
          If (GetAttr(favFolder & "\" & sDirectory & "\" & sSubDirectory)
And vbDirectory) = vbDirectory Then
 
            Print #1, PrintFile
 
            'MANCA CICLO PER FILE E ULTERIORI SUB DIRECTORY
          Else
            Print #1, PrintFile
          End If
        End If
        sSubDirectory = Dir
      Loop
    End If
    Call posiziona(favFolder, sDirectory)
  End If
  sDirectory = Dir   ' Legge la voce successiva.
 Loop
 Print #1, ""
 
Errore:
 Print #2, PrintFile
 Resume Next 'ritorno
End Sub
------------------------------------------------
Private Function posiziona(percorso As String, nome As String)
Dim cerca As String
  cerca = Dir(percorso & "\", vbNormal Or vbHidden Or vbReadOnly Or
vbSystem Or vbDirectory)   ' Si posiziona sul primo file
  Do While nome <> ""
    If cerca = nome Or cerca = "" Then Exit Function
    cerca = Dir
  Loop
End Function
------------------------------------------------
Sub CercaFile(percorso As String)
Dim cerca As String
  cerca = Dir(percorso, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or
vbDirectory)
  Do While cerca <> ""
    If cerca <> "." And cerca <> ".." And Right(UCase(cerca), 4) <> ".SYS"
Then
      If (GetAttr(percorso & cerca) And vbDirectory) <> vbDirectory Then
        Print #1, percorso & cerca
      End If
    ElseIf Right(UCase(cerca), 4) = ".SYS" Then
      Print #1, percorso & cerca
    End If
    cerca = Dir
  Loop
End Sub
------------------------------------------------

secondo me dovresti provare con un oggetto FileSystemObject
e con un a funzione ridondante che chiama se stessa e avente come
paramtri il percorso di cartella
esempio (pseudocodifica):
function CercaInCartella(optional CartellaPadre as object)
se CartellaPadre è Nothing
         CartellaPadre = C:\
fine se
per ogni SubCartella in CartellaPadre
        CercaInCartella ( subcartella )
Prossimo
oggettoFiles= CartellaPadre.Files
per ogni file in oggettoFiles
    print #1, file.getFileName
prossimo









procedura con FileSystemObject:  Conta tutti gli oggetti(files + subfolders) 
di una Dir compresa la stessa.....
è una funzione ricorsiva..... modificala per il tuo scopo...
P.S: ricorda i riferimenti a "scruun.dll"
ciao
'---------------------------------------------------------------------------------------
' Procedure : NodeCountFSO
' DateTime  : 21/03/2007 11.16
' Author    : Andrea
' Purpose   : Conta tutti gli oggetti(files + subfolders) di una Dir 
compresa la stessa
'
' Ritorno: il numero degli oggetti; -1 se la dir passata non è valida; -2 
insuccesso
'---------------------------------------------------------------------------------------
'
Public Function NodeCountFSO(PercorsoDirectory As String) As Long
    Dim fso As FileSystemObject
    Dim fsoFolder As Folder
   On Error GoTo NodeCountFSO_Error
    If Not DirExist(PercorsoDirectory) Then
        NodeCountFSO = -1
        Exit Function
    End If
    Set fso = New FileSystemObject
    Set fsoFolder = fso.GetFolder(PercorsoDirectory)
    'Il +1 rappresenta la cartella corrente
    CountItem = fso.GetFolder(PercorsoDirectory).Files.Count + 1
    For Each fsoFolder In fso.GetFolder(PercorsoDirectory).SubFolders
        CountItem = CountItem + NodeCountFSO(fsoFolder.Path)
    Next
    NodeCountFSO = CountItem
   On Error GoTo 0
   Exit Function
NodeCountFSO_Error:
    'ritorna insuccesso
    NodeCountFSO = -2
End Function
"Andrea" <nos...@invalid.com.invalid> ha scritto nel messaggio 
news:1wzwu4hp7lekt.o...@40tude.net...


Avete qualche consiglio?
Qui c'è un esempio:
http://www.it-lang-vb.net/download.asp?file=http://www.it-lang-vb.net/Archivio/Sorgenti/AllDir.zip&ID=169
--
ciao
  Stefano

 ha
scritto:

Anche qui:
http://www.maurorossi.net/codice/dirlist.zip
--
ciao
  Stefano