Newsgroup: it.comp.appl.access
Titolo: cancellare cartelle vuote

buongiorno
nel mio DB vengono create delle cartelle man mano che si inseriscono nuovi 
record, in queste cartelle vado ad inserire degli allegati quando sono 
disponibili.
Alcune di queste cartelle tuttavia restano vuote e desidero cancellarle alla 
chiusura del DB.
 
La struttura delle cartelle è cosi:
path...\cartella\subfold\ID
 
mi piacerebbe cancellare tutte le cartelle ID vuote e qualora le subfold 
risultassero vuote cancellare anch'esse.
Ho provato a scrivere una cosa del genere:
 
Dim GetDBPath As String
 
GetDBPath = CurrentProject.Path & "\test\"
 
If Len((GetDBPath)) = 0 Then
   MsgBox "La cartella è vuota"
  RmDir (GetDBPath)
  Else
MsgBox "La cartella è piena"
End If
 
ma non funziona.
 
gentilmente mi suggerite come proseguire
 
grazie
Akery 
 

"Akery"  ha scritto nel messaggio news:nhesg2$1ctk$1...@gioia.aioe.org...

Sono riuscito a fare qualche progresso scrivendo il codice cosi:
 
Option Compare Database
 
 
Function cleanfolder()
Dim fso As Object
Dim folder
Dim subfolder
Dim fld
 
GetDBPath = CurrentProject.Path & "\allegati\"
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(GetDBPath)
Set subfolder = folder.subfolders
 
 
For Each fld In subfolder
cartella = fld.Name & "\"
If Dir(GetDBPath & cartella) = "" Then
MsgBox ("La cartella " & cartella & " è vuota")
RmDir GetDBPath & cartella
  Else
MsgBox ("La cartella " & cartella & " è piena")
End If
 
Next
 
End Function
 
ma ancora non riesco a capire come cancellare le sotto-sottocartelle.
 
un aiutino? per piacere 
 

 ma ancora non riesco a capire come cancellare le sotto-sottocartelle.
 
Dovresti fare una chiamata ricorsiva
 
In italiano:
se gethpath(Par)=Vero allora  RemoveDir
 
GetPath:
vuoto? ritorno Vero
non  vuoto?
	e' una  Dir? allora ritorno getpath(newPar)
	e' altro ritorno False
 
Probabilmente in rete se cerchi ci sara' da qualche parte un po' di 
codice che lo fa.
-- 
ac (x=y-1)
Aborro il Killfile
(La violenza e' l'ultimo rifugio degli incapaci -Salvor Hardin-)
 
---
Questa e-mail è stata controllata per individuare virus con Avast antivirus.
https://www.avast.com/antivirus
 
 

 
 
"Alessandro Cara"  ha scritto nel messaggio 
news:6iZ_y.45386$pt.2...@tornado.fastwebnet.it...

Grazie per la risposta,
ho trovato qualcosa in rete ma ho difficoltà a scendere nelle 
sotto-sottocartelle, mi spiego meglio: sto utilizzando il comando dir che è 
tanto bello se ci sono file, ma non sono in grado di servirmene se ci sono 
cartelle, ora tralasciando la questione dell'eliminare la cartella la cosa 
che più si avvicina a quel che voglio fare è questo:
 
Function cleanfolder()
Dim fso As Object
Dim folder
Dim subfolder
Dim fld
 
GetDBPath = CurrentProject.Path & "\allegati\"
 
' ricerca delle subfolder nelle folder
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(GetDBPath)
Set subfolder = folder.subfolders
 
For Each fld In subfolder
cartella = fld.Name
If Dir(GetDBPath & cartella & "\*.*") = "" Then
MsgBox (cartella & " vuota")
'RmDir GetDBPath & cartella & "\"
 
Else
MsgBox (cartella & " non vuota")
End If
 
 
Next
 
End Function
 
ma come dicevo se nella cartella c'è una cartella tutto si vanifica :(
 
 

 

Perchè creare delle cartelle e poi faticare per cancellarle?
Non è meglio ottimizzare il codice e far creare le cartelle solo quando realmente servono, quindi quando inserisci l'allegato?
Ciao.
-Marco-
 
 

 'RmDir GetDBPath & cartella & "\"
 
Forse non mi sono spiegato
Questa roba qui:
Set subfolder = folder.subfolders
 
Cosa ti da?  Ovviamente tutti gli oggetti di tipo folder.
Se uno di questi elementi a  cui tu accedi con la for each
contiene a sua volta delle cartelle devi reiterare
/praticamente/ lo stesso codice e continuare a reiterare
sui nuovi /paths/   (da qui la necessita' di chiamata *ricorsiva*)
fino a quando la /collezione/ subfolder e' vuota (subfolder.count=0).
Solo in quel caso devi verificare se non ci sono /files/ .
Tra l'altro non serve fare la dir poiche' l'oggetto /folder/
contiene una collezione *Files* che come tutte le collezioni che
si rispettano ha il metodo /count/ che ritorna 0 se la
collezione e' vuota.
 
Il codice da te postato /non/ fa questo ma si limita
a controllare il primo livello sub.
 
 
Qui:
https://msdn.microsoft.com/en-us/library/x75sb7ff%28v=vs.84%29.aspx
 
il *reference* se non lo hai ancora guardato


Fai una prova banale... su una cartella prima con un Allegato poi vuota... e prova a cancellarla semplicemente con un KILL.
 
Siccome il comando KILL non consente di eliminare una Folder finchè questa non è vuota credo il tutto si possa risolvere nel PROVI a cancellarla e se riesce era vuota...
 
@Alex

 
"@Alex"  ha scritto nel messaggio 
news:23084a6d-8838-4a04...@googlegroups.com...

RISOLTO!
 
con la seguente scrittura:
 
Function cleanfolder()
Dim fso As Object
Dim folder
Dim subfolder
Dim fld
 
Dim fso2 As Object
Dim folder2
Dim subfolder2
Dim fld2
 
GetDBPath = CurrentProject.Path & "\allegati\"
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(GetDBPath)
Set subfolder = folder.subfolders
 
' pulizia al 2 livello
For Each fld In subfolder
cartella = fld.Name
 
Set fso2 = CreateObject("Scripting.FileSystemObject")
Set folder2 = fso2.GetFolder(GetDBPath & cartella)
Set subfolder2 = folder2.subfolders
 
For Each fld2 In subfolder2
 
idfolder = fld2.Name
 
If Dir(GetDBPath & cartella & "\" & idfolder & "\*.*") = "" Then
'MsgBox (cartella & "\" & idfolder & " vuota")
 
RmDir GetDBPath & cartella & "\" & idfolder & "\"
 
 
Else
'MsgBox (cartella & "\" & idfolder & " non vuota")
End If
Next
Next
 
'pulizia al primo livello
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(GetDBPath)
Set subfolder = folder.subfolders
 
For Each fld In subfolder
cartella = fld.Name
 
If Dir(GetDBPath & cartella & "\*.*") = "" Then
'MsgBox (cartella & "\" & " vuota")
 
RmDir GetDBPath & cartella & "\"
 
 
Else
'MsgBox (cartella & "\" & " non vuota")
End If
Next
 
End Function
 
un giorno non molto lontano imparerò che cosa è una ricorsiva, grazie.
Sono gradite critiche per migliorare