Eliminare cartella dopo averla compressa con shell.application

di
eternityck
il
8 risposte
E
eternityck
Utente Attivo
Iscritto da
mag, 2018
Messaggi:
171

Eliminare cartella dopo averla compressa con shell.application

Salva a tutti, ho trovato ed adattato un codice per comprimere una cartella con file xml tramite vba
il codice è questo:
con questa sub creo un file zip vuoto 
Sub NewZip(sPath)
'Create empty Zip File
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
con questo invece inserisco i file xml dentro il file zip 
Dim FileNameZip, Folder
Folder = PathFolder & NomeFolder & "\"
FileNameZip = PathFolder & NomeFolder & ".zip"
'Create empty Zip File
NewZip (FileNameZip)

Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
'Copio i File nella cartella compressa
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(Folder).items
'Keep script waiting until Compressing is done
Do Until oApp.Namespace(FileNameZip).items.Count = oApp.Namespace(Folder).items.Count
Loop
Ora il mio problema sta nel voler elimnare la cartella crea dopo averla zippata ed ho inseirto questo codice
'Elimina tutti i file presenti nella cartella e la cartella stessa
FileKill = PathFolder & NomeFolder & "\*.*"
FolderDel = PathFolder & NomeFolder
Kill (FileKill)
RmDir (FolderDel)
ovviamente non funziona! credo sia dovuto al fatto che l'operazione di compressione sia asincrona e quindi quando il codice arriva al momento della cancellazione dei file e della cartella mi da autorizzazione negata.
come posso risolvere?

8 Risposte

  • @Alex
    @Alex
    Super Famoso
    Iscritto da
    feb, 2012
    Messaggi:
    8752

    Re: Eliminare cartella dopo averla compressa con shell.application

    Se fosse questione di SINCRONIZZAZIONE, ti basterebbe mettere un Button e su quello inserire il codice eseguendolo con calma: 
    
'Elimina tutti i file presenti nella cartella e la cartella stessa
FileKill = PathFolder & NomeFolder & "\*.*"
FolderDel = PathFolder & NomeFolder
Kill (FileKill)
RmDir (FolderDel)
    Se quindi fosse confermato ti suggerisco di mettere un Delay e farla eseguire.
    Quì trovi Varianti al tema:
    https://www.rondebruin.nl/win/s4/win004.ht

    Per lo ZIP... Io ti suggerirei di usare questo codice... che, è leggermente più funzionale, pur essendo equivalente, all'uscita Ciclo Elimini:
    https://codekabinett.com/rdumps.php?Lang=2&targetDoc=create-zip-archive-vba-shell32

    Saluti
  • E
    eternityck
    Utente Attivo
    Iscritto da
    mag, 2018
    Messaggi:
    171

    Re: Eliminare cartella dopo averla compressa con shell.application

    Buongiorno Alex, mettendo un button risolvo il problema ma vorrei riuscire a farlo in automatico, senza dover premere un ulteriore pulsante.
    infatti l' alternativa che ho pensato era di creare due tempvars ed utilizzarle per cancellare i file e le cartelle all' uscita della maschera

    avevo già visto il codice di zippaggio che mi hai allegato ed in effetti era indeciso quale usare.

    dici che provando questo codice risolvo il probema? ho letto nell' 3d che essendo asincrono non posso sapere quando finisce, quindi credo che il problema permanga

    per quanto riguarda il delay ho preso ispirazione proprio da questo codice.
    ho provato ad usare anche il codice che elimina la cartella tramite createobject ma mi da lo stesso errore
  • @Alex
    @Alex
    Super Famoso
    Iscritto da
    feb, 2012
    Messaggi:
    8752

    Re: Eliminare cartella dopo averla compressa con shell.application

    eternityck ha scritto:

    Buongiorno Alex, mettendo un button risolvo il problema ma vorrei riuscire a farlo in automatico, senza dover premere un ulteriore pulsante.
    Se rileggi BENE quello che ti ho scritto era un suggerimento Diagnostico non risolutivo, infatti ti ho detto che nel caso fosse confermato, serviva un Delay... cosa non ti era chiaro....?

    eternityck ha scritto:

    infatti l' alternativa che ho pensato era di creare due tempvars ed utilizzarle per cancellare i file e le cartelle all' uscita della maschera

    avevo già visto il codice di zippaggio che mi hai allegato ed in effetti era indeciso quale usare.

    dici che provando questo codice risolvo il probema? ho letto nell' 3d che essendo asincrono non posso sapere quando finisce, quindi credo che il problema permanga
    Rimane sicuramente ma è decisamente meglio, io introdurrei anche un DoEvents nel LOOP.

    eternityck ha scritto:

    per quanto riguarda il delay ho preso ispirazione proprio da questo codice.
    ho provato ad usare anche il codice che elimina la cartella tramite createobject ma mi da lo stesso errore
    Per il ritardo basta uno SLEEP API... 
    
Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub TuaSub()
   TuoCodice ZIP
   Call Sleep (1000)
   Tuocodice Delete
End Sub
    Volendo invece essere certi del Termine... puoi provare ad aprire in modalità Lock il File ZIP che stai generando... finchè da errore è in scrittura... quando lo apre, il processo di SHELL è terminato e puoi andare a fare il DELETE delle cartelle.

    Quì trovi il codice:
    https://exceloffthegrid.com/vba-find-file-already-open

    In sostanza devi fare un Loop che esce solo se quando il File è LIBERO, a quel punto fai il Delete.
    Se usi questo metodo che a mio avviso è meglio, attenzione di inserire un TimeOut ed ovviamente su TimeOut non vai a fare il Delete ma un Messaggio...
  • E
    eternityck
    Utente Attivo
    Iscritto da
    mag, 2018
    Messaggi:
    171

    Re: Eliminare cartella dopo averla compressa con shell.application

    Allora seguendo il consiglio di Alex ho abbozzato questo codice:
    Dim fileName As String
fileName = PathFolder & NomeFolder & ".zip"
LineCheck:
'Call function to check if the file is open
If IsFileOpen(fileName) = False Then
FileKill = PathFolder & NomeFolder & "\*.*"
FolderDel = PathFolder & NomeFolder
Kill (FileKill)
RmDir (FolderDel)
Else
MsgBox fileName & " is already open."
GoTo LineCheck
'The file is open or another error occurred
End If
    ma non è la soluzioni:
    primo ho messo un msgbox per controllo e non lo avvia quindi il file non è aperto
    secondi l' errore 70 me lo dà su 
    Kill (FileKill)
    dell' ultimo xml creato cioè quando dalla maschera ne creo piu di uno xml tutt gli altri si cancellano tranne l' ultimo e mi dà errore
    ho provato a cambiare filename con 
    varFile & ".xml"
    che è il nome dell' ultimo file ma non gli risulta aperta
  • @Alex
    @Alex
    Super Famoso
    Iscritto da
    feb, 2012
    Messaggi:
    8752

    Re: Eliminare cartella dopo averla compressa con shell.application

    Non hai fatto quello che ho detto... io dicevo di fare un LOOP che controllava se il file era Terminato o meno... tu lo verifichi solo 1 volta.

    Fai attenzione... e leggi meglio.
  • E
    eternityck
    Utente Attivo
    Iscritto da
    mag, 2018
    Messaggi:
    171

    Re: Eliminare cartella dopo averla compressa con shell.application

    Questa parte mi sfugge o meglio non ho capito come fare.
    Io pensavo che con il GOTO avrei risolto
  • @Alex
    @Alex
    Super Famoso
    Iscritto da
    feb, 2012
    Messaggi:
    8752

    Re: Eliminare cartella dopo averla compressa con shell.application

    Hai la medesima cosa nel CODICE che hai incollato al 1° 3D... quindi deduco tu non lo abbia compreso... ma copia/incollato...! 
    
Dim bLoopExpired  As Boolean
Dim sStartTime    As Single

sStartTime=Timer()
Debug.Print Format(sStartTime,"hh:mm:ss")
Do Until IsFileOpen(fileName)=False
   If Timer()-sStartTime>100 then 
        Debug.Print Format(Timer(),"hh:mm:ss")
        bLoopExpired =true
        Exit Do
   End If
   DoEvents
Loop
If Not bLoopExpired  then
    Kill "....."
End if
    Questo codice in linea teorica si ALLUPPA finchè la funzione IsFileOpen(...) non restituisce FALSE, che significa che il File è LIBERO.
    Ti avevo suggerito però di inserire un TIMEOUT, quindi Leggi il Timer prima di iniziare il LOOP e, lo interrompi oltre che per IsFileOpen(fileName) = False, anche per superamento del Tempo Limite, ottenuto per differenza dal TempoINiziale ed il tempo Attuale...
    La seconda condizione la metti all'interno del LOOP e forzi un Flag nel caso intervenga in modo da sapere che sei uscito per TIMEOUT.

    Non ho testato il codice, ma scritto a braccio... verificalo e adatta il Tempo di TimeOut che ho messo a 100 ma sicuramente è troppo, ti ho messo i DEBUG.PRINT dei 2 Valori Orari per capire di cosa parliamo...
  • E
    eternityck
    Utente Attivo
    Iscritto da
    mag, 2018
    Messaggi:
    171

    Re: Eliminare cartella dopo averla compressa con shell.application

    Buongiorno Alex, intanto grazie sempre per la tua pazienza ho messo questo codice ma non và 
    Dim bLoopExpired  As Boolean
Dim sStartTime    As Single
Dim fileName As String

fileName = varFile & ".xml"
sStartTime = Timer()
Debug.Print Format(sStartTime, "hh:mm:ss")
Do Until IsFileOpen(fileName) = False
   If Timer() - sStartTime > 100 Then
        Debug.Print Format(Timer(), "hh:mm:ss")
        bLoopExpired = True
        Exit Do
   End If
   DoEvents
Loop
If Not bLoopExpired Then
FileKill = PathFolder & NomeFolder & "\*.xml"
Kill (FileKill)
RmDir (PathFolder & NomeFolder)
End If
    il filename che ho messo, dopo diversi tentativi è il nome del ultimo file creato. l'ho messo come filename l' ultimo file creato perchè in realtà il Kill elimina tutti i file creati tranne l' ultimo, come se l' ultimo file rimanesse appeso fino a che non si esce dalla Sub.
    dal debug si vede che mi dà il primo time e poi va in errore 75 su kill, da qui deduco che il problema non è lì perchè vuol dire che il codice lo legge come file chiuso.
    a questo punto forse il problema sia nel codice che crea lo zip quindi magari provo a riscrivere il codice con quello che mi hai link e vedo se non fà questo problema
Devi accedere o registrarti per scrivere nel forum
8 risposte