Allora, grazie ai vostri link sono riuscito a buttare giù una funzione grezza, che poi volevo affinare, ma ho riscontrato 2 strani problemi:
Sol 1 (grezza):
Sub costruisciAlbero(path As String, padre As String)
On Error Resume Next
Set fld = fso.GetFolder(path)
For Each subfld In fld.SubFolders
If (padre = "" Or padre = "OHSAS 18001") Then
Set tmpnode = Me.AlberoOHSAS.Nodes.Add(, , "ID_" & subfld.Name, subfld.Name, 1)
Else
padre = Right(subfld.ParentFolder, Len(subfld.ParentFolder) - InStrRev(subfld.ParentFolder, "\", , vbTextCompare))
Set tmpnode = Me.AlberoOHSAS.Nodes.Add("ID_" & padre, tvwChild, "ID_" & subfld.Name, subfld.Name, 1)
End If
tmpnode.Expanded = False
costruisciAlbero subfld.path, fld.Name
Next subfld
For Each fl In fld.Files
If (fl.Name <> "MODULI.txt") Then
Set tmpnode = Me.AlberoOHSAS.Nodes.Add("ID_" & fld.Name, tvwChild, "ID_" & fl.Name, fl.Name, 2)
End If
Next
Exit Sub
End Sub
per come è costruito il ciclo, si visitano 2 volte le ultime sottodir che vengono visitate.
Ho pensato dunque di affinare la soluzione (anche se con il resume next fa alla grande il suo lavoro) inserendo un unico ciclo nella ricorsione e di fare un if per vedere se si tratta di una cartella
sol 2:
Sub creaAlbero(path As String, parent As String)
On errorr GoTo errore
dr = Dir(path, vbDirectory)
Do
If ((dr <> ".") And (dr <> "..") And (dr <> "")) Then
If GetAttr(path & dr) = vbDirectory Then
Set tmpnode = Me.AlberoOHSAS.Nodes.Add("ID_" & CStr(parent), tvwChild, "ID_" & dr, dr, 1)
creaAlbero path & dr & "\", dr
Else
If (dr <> "MODULI.txt") Then
Set tmpnode = Me.AlberoOHSAS.Nodes.Add("ID_" & CStr(parent), tvwChild, "ID_" & dr, dr, 2)
End If
End If
End If
dr = Dir
Loop While (dr <> "")
Exit Sub
errore:
MsgBox Error.Description
End Sub
il problema assurdo è ke quando eseguo
dr = Dir(path, vbDirectory)
anche parent assume lo stesso valore e perdo il contenuto originale.
Suggerimenti?