› Sviluppare funzionalita su Microsoft Office con VBA › Estrarre file da archivi zip e smistarli in cartelle specifiche
-
AutoreArticoli
-
Salve ragazzi,
spero di non andare contro le regole (avevo messo come risolto il caso ma)
ho terminato l'ntegrazione con il resto del mio codice ma ho qualche altra cosa che mi piacerebbe migliorare.
1) ho più macro che lavorano nello stesso file excel alcune sono nei moduli altre (una) all'interno del foglio1
Ora si attivano con un bottone per ogni singola macro ma vorrei farle eseguire tutte anche con un unico bottone.
2) il codice funziona solo se i file da trattare sono in una cartella locale. Se sono in un server che raggiungo da pc attraverso la maschera di selezione inserita per la scelta dell'orinige il codice entra in debug. (io ora us una cartela di drive ma dovrei poi usare una cartella su un server)
ho letto in giro e credo di aver compreso che VBA ha bisogno di sapere se si tratta di cartelle locali o su server.
Se volessi mettere tutto su cartella di un server questa cosa si può fare sia per la cartella di origine (dove diversi utenti depositano i file da trattare) che per le cartelle che crea il codice in cui vengono smistati e archiviati i file?
Grazie in anticipo.
_____________________________
Allego file xmls con file da trattare.
nel file xmls ci sono due fogli nascosti in cui il codice inserisce i dati dei fogli excel di origine
NB. i file di origine xls non contengo dati per motivi di privacy ma hanno tutte le colonne necessarie e le righe che potrebbero essere presenti.
Luigi
Allegati:
You must be logged in to view attached files.luilomo wrote:vorrei farle eseguire tutte anche con un unico bottone
Cosa intendi? che nel codice di evento Click del pulsante vuoi richiamare più di una macro?
luilomo wrote:Se sono in un server che raggiungo da pc attraverso la maschera di selezione inserita per la scelta dell'origine
Perchè? ho fatto una prova di selezione file dalla maschera di FileDialog e accede/apre tranquillamente un file sul server.
Credo che sia indifferente se il file che contiene la macro sia locale o sul server,ma va verificato. I percorsi dovrebbero iniziare con "\\".
Adesso guardo il file che hai allegato.
Si esattamente con un bottone solo.
Ho provato a creare una sub che ruchiami tutte ma mi da errore probabilmente a casua del caos che ho datto tra sub e variabili. 🙄
Grazie
Riesci a mostrare questa sub?
Perchè davvero, non è una cosa impossibile da fare 🙂
Eccola
`Public Sub tutto() ' sub per eseguire gli aggiornamenti con un solo bottone Call manage_zips3 Call importAllXls Call Split_link Call Riepilogo End Sub`
e nell'immagine il messaggio di errore,
Allegati:
You must be logged in to view attached files.Ecco volevo suggerire proprio una cosa come questa.
luilomo wrote:una sub che richiami tutte ma mi da errore
A questo punto devi dirmi che errore ottieni 🙂
Presumo che non tutte siano sub pubbliche.
Per favore, la prossima volta fai un nuovo post, non modificarne uno vecchio (come hai fatto allegando l'immagine dell'errore) altrimenti rischia di sfuggire 🙂
Comunque il messaggio è chiaro: la sub "importAllXls" non esiste o non è accessibile.
Infatti si trova nel foglio1 (consiglio di mettere i moduli pubblici in un modulo).
In questo caso la sintassi corretta per chiamare la procedura è la qualifica piena del nome:
Call Foglio1.ImportAllXls
By the way, hai routine uguali in moduli diversi. Una volta che una routine è definita come pubblica, non serve replicarla perchè è visibile a tutto il progetto. Generalmente non è cosa buona avere routine diverse con lo stesso nome (ci sono due Sub Unzip, per esempio).
OK. Gazie mille.
Pulisco il file e cancello routine non utili le usavo come bae da cui partire per integrare il codice.
Insomma ho creato in Frankestein Junior "Si Può FAREEEEE" 😆
Domanda se volessi togliere dal foglio1 la Public Sub e metterla in un modulo ci sono probelmi per le variabili etc...?
Le variabili in una sub pubblica sono disponibili (dichiarazione, valori etc..) anche nelle altre sub?
Al contrario nelle sub non pubbliche restano disponibili solo nella sub specifica e si azzerano quando si giunge a end sub?
Luigi
luilomo wrote: Domanda se volessi togliere dal foglio1 la Public Sub e metterla in un modulo ci sono problemi per le variabili etc...?
Assolutamente no. Le variabili devono rispettare le regole della sintassi prevista ma sono uguali, nel funzionamento, sia che tu le usi nei moduli foglio che nei moduli standard. La cosa importante è che come prima riga di tutti i tuoi codici tu metta la direttiva "Option Explicit", sempre 🙂
luilomo wrote:Le variabili in una sub pubblica sono disponibili (dichiarazione, valori etc..) anche nelle altre sub?
No. Hanno visibilità solo locale, cioè interna alla sub in cui vengono usate.
Puoi però dichiarare variabili globali in testa al modulo, subito sotto Option Explicit: dichiarandole Private sono visibili solo al modulo in cui le dichiari, dichiarandole Global, Public o Dim diventano globali a tutto il progetto.
luilomo wrote:Al contrario nelle sub non pubbliche restano disponibili solo nella sub specifica e si azzerano quando si giunge a end sub?
Questo è corretto. E' il concetto di visibilità (in inglese scope, si parla anche di "vita") della variabile. Non è che si "azzerano", semplicemente il loro spazio in memoria viene deallocato e reso disponibile per altre variabili. In pratica si annientano (a meno che non siano state dichiarate Static, nel qual caso mantengono il valore tra una chiamata e l'altra della routine).
Ciao,
credo non i sia chiara la spiegazione delle variabili.
ok ho creato la sub tutto fuziona ma ora ho problemi nella gestione dei messaggi in base al comportamento dell'utente.
Come si vede dal codice presente nel file zip (messaggi precedenti) in ogni sub ho gestito ( a modo mio 🙄 ) i comportamento di "annulla" quando le sub sono avviate singolarmente. Fin qui nessun problema.
Ora Però avviando dalla Public sub RunAll, una volta arrivati alla prima Call, se l'utente fa annulla già nella maschera di scelta dell'origine dei file la RunAll continua la sua esecuzione passando alla sub successiva. no buono
Pensavo di mettere in ogni sub il valore della variabile Rispall e fare un controllo con un If then per capire se l'utente ha avviato la procedura da Run All o dalla singola Sub. In questo modo posso bypassare i messaggi che al contrario devono essere presenti ad avvio singolo di ogni sub.
Risultato NON riesco a far passare il valore della variabile nelle singole sub.
Come faccio ad interrompere la RunAll?
Il comando "exit sub" nelel singole sub interrompe la sub singola ma la RunAll continua il suo percorso.
Exit
Eventualmente c'è un altro metodo?
Public Sub RunALL() ' ' RunALL Macro ' sub per eseguire gli aggiornamenti con un solo bottone Dim Rispall As Integer Rispall = MsgBox("AVVIO PROCEDURA AGGIORNAMENTO DATI" & vbNewLine & "Proseguire?", 1 + 48, "Aggiornamento dati") If Rispall = 2 Then MsgBox "PROCEDURA ANNULLATA", 0 + 64, "Aggiornamento dati" Exit Sub Else End If Application.ScreenUpdating = False Call manage_zips3 Call Foglio1.importAllXls Call Foglio1.Split_link Call Riepilogo End Sub
Nei msgbox puoi usare le costanti così non devi ricordarti i numeri 🙂
Option Explicit Public answer As Long Public Sub xRunALL() ' ' RunALL Macro ' sub per eseguire gli aggiornamenti con un solo bottone If MsgBox("AVVIO PROCEDURA AGGIORNAMENTO DATI" & vbNewLine & "Proseguire?", vbOKCancel + vbExclamation, "Aggiornamento dati") = vbCancel Then MsgBox "PROCEDURA ANNULLATA", vbInformation, "Aggiornamento dati" Exit Sub End If answer = 0 Call manage_zips3 If answer = vbNo Then MsgBox "PROCEDURA ANNULLATA", vbInformation, "Aggiornamento dati" Exit Sub End If answer = 0 Call Foglio1.importallxls If answer = vbNo Then MsgBox "PROCEDURA ANNULLATA", vbInformation, "Aggiornamento dati" Exit Sub End If answer = 0 Call Foglio1.Split_link If answer = vbNo Then MsgBox "PROCEDURA ANNULLATA", vbInformation, "Aggiornamento dati" Exit Sub End If answer = 0 Call riepilogo If answer = vbNo Then MsgBox "PROCEDURA ANNULLATA", vbInformation, "Aggiornamento dati" Exit Sub End If End Sub
per l'aspetto che riguarda la variabile pubblica answer, questa ti serve per far passare una variabile a tutti i moduli del progetto, rendendola pubblica e quindi modificabile da tutte le routine.
io apportere queste modifiche:
If answer = 2 Then MsgBox "PROCEDURA ANNULLATA", vbInformation, "Aggiornamento dati" Exit Sub
a tutte le chiamate
e nelle routine di chiamata aggiungerei questo
If ris1 = 2 Then MsgBox "PROCEDURA ANNULLATA", 0 + 64, "AGGIORNAMENTO DATI" answer = ris1 Exit Sub
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Tutto dipende dal valore di answer nelle varie subroutine chiamate; io avevo ipotizzato che i pulsanti disponibili fossero Yes e No ma va bene anche Ok e Cancel. Tra parentesi, preferisco l'uso delle costanti perchè sono più leggibili rispetto a "If answer = 2" 🙂
vecchio frac wrote:leggibili rispetto a "If answer = 2"
si , ma lui in tutte le sub per uscire ,esce con il valore 2
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )Che corrisponde a vbCancel ... l'importante è il concetto e che sappia gestire questo valore a livello di variabile pubblica.
Ciao,
purtroppo per motivi di lavoro non sono riuscito ancora fare e modifiche suggerrite.
Ma oggi ho provato ad avviare lo scrit ed ho avuto un errore nella procedura della sub managed_zips3 con debug come da immagine e blocco alla riga in rosso della sub allegata
''' 3) Ciclo n. 2 tutti i file della cartella spedire presente in TMP e avvio lo smistamento in base all'estensione
nfiles = 0
For Each f2 In fso.getfolder(tmp & "\spedire").FilesOption Explicit '''###################################################################### '''###################################################################### '''## versione 1.0 del 07/10/2018 ## '''## Peocedura per rinominare eventuali file sena estensione con ## '''## nomefile.zip successivamente scompatta tutti gli archivi e ## '''## smista i file in cartelle specifiche se le cartelle non ## '''## ci sono vengono create dal sistema. ## '''## ATTENZIONE non inserire il file che contiene la ## '''## procedura nella stessa cartella dove sono i file da elaborare ## '''###################################################################### '''###################################################################### Sub manage_zips3() ' Dim fd As Object Dim v As Variant Dim fso As Object, f As Object, f2 As Object Dim fi As String Dim s As String Dim z As String Dim sShell As String Dim wkMe As Workbook Dim path As String Dim sPath1 As String Dim archive As String Dim tmp As String Dim smista As String Dim renamed As String Dim nfilez As Integer Dim nfiles As Integer Dim nfilet As Integer 'metto un riferimento a questo Workbook Set wkMe = ThisWorkbook 'metto nella variabile sPath1 il percorso di questo file sPath1 = wkMe.path & "\DATI" 'impedisco lo *sfarfallio* del monitor Application.ScreenUpdating = False archive = sPath1 & "\ARCHIVE" 'percorso cartelle che se non presenti verranno create tmp = sPath1 & "\TMP" 'percorso cartelle che se non presenti verranno create smista = sPath1 & "\SMISTA" 'percorso cartelle che se non presenti verranno create renamed = sPath1 & "\RENAMED" 'percorso cartelle che se non presenti verranno create ''' Finestra di dialogo permette di selezionare l'origine dei file da elaborare Set fd = Application.FileDialog(msoFileDialogFolderPicker) ' fd.Title = "Seleziona la cartella di origine dei file da elaborare" fd.InitialFileName = sPath1 & "Seleziona Origine dati" 'percorso iniziale da presentare all'utente v = fd.Show If v = -1 Then '''controllo l'esistenza delle cartetelle di destinazione se non preenti le crea nel percorso indicato precedentemente Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.folderexists(sPath1) Then MkDir sPath1 If Not fso.folderexists(tmp) Then MkDir tmp If Not fso.folderexists(archive) Then MkDir archive If Not fso.folderexists(smista) Then MkDir smista If Not fso.folderexists(renamed) Then MkDir renamed If Not (fso.folderexists(smista & "\EXCEL")) Then MkDir smista & "\EXCEL" If Not (fso.folderexists(smista & "\WORD")) Then MkDir smista & "\WORD" If Not (fso.folderexists(smista & "\TEXT")) Then MkDir smista & "\TEXT" If Not (fso.folderexists(smista & "\PDF")) Then MkDir smista & "\PDF" If Not (fso.folderexists(smista & "\ALTRI")) Then MkDir smista & "\ALTRI" ''' AVVIO CICLO FOR EACH file presenti nella cartella di origine selezionata ''' 1) Verifico l'estensione con la funzione get-ext e rinominarli eventualmente con "nomefile.zip" 'sPath1 = path nfilez = 0 For Each f In fso.getfolder(fd.SelectedItems(1)).Files nfilez = nfilez + 1 'n file zip scompattati z = f.path 'assegno a z il percoso di origine fi = f.Name 'assegno a fi il nome del file che analizzo If get_ext(f.path) <> "zip" Then 'controllo l'estensione del file ed eseguo la funzione get_ext Name f.path As f.path & ".zip" z = z & ".zip" ' se <> da zip e = a "" inserisco estesione .zip End If ''' 2) Il file viene decompresso il TMP con la funzione Unzip Unzip z, tmp ''' 3) Ciclo n. 2 tutti i file della cartella spedire presente in TMP e avvio lo smistamento in base all'estensione nfiles = 0 For Each f2 In fso.getfolder(tmp & "\spedire").Files nfiles = nfiles + 1 'numeri di file smistati in ogni ciclo s = LCase(get_ext(CStr(f2))) 'leggo l'estesione del file con la funzione get_ext Select Case s Case "xlsx", "xlsm", "xlst", "xls" v = smista & "\EXCEL" Case "docx", "docm", "doct", "doc" v = smista & "\WORD" Case "txt", "csv" v = smista & "\TEXT" Case "pdf" v = smista & "\PDF" Case Else v = smista & "\ALTRI" End Select FileCopy f2.path, v & "\" & f2.Name Next nfilet = nfilet + nfiles ' n totale files smistati ''' fine ciclo n. 2 ''' 4) Gestisco il file di origine *.zip FileCopy z, archive & "\" & fi ' lo copio in archive FileCopy z, renamed & "\" & fi & IIf(InStr(fi, ".") = 0, ".zip", "") ' lo copio in renamed con la nuova estenzione .zip Kill z 'cancello il file trattato dalla cartella di origine Kill tmp & "\spedire\*.*" ' cancello la cartella spedire in tmp RmDir tmp & "\spedire" Next 'passo al successivo file RmDir tmp MsgBox "Procedura terminata con successo" & vbNewLine & vbNewLine & "- " & nfilez & " - files zip elaborati" & vbNewLine & "- " & nfilet & " - smistati in: " & vbNewLine & vbNewLine & sPath1 & vbNewLine & vbNewLine & " Ora procedere con le altre azioni.", vbInformation Else MsgBox "PROCEDURA ANNULLATA", 0 + 64, "Download Files" Exit Sub End If End Sub Private Function get_ext(f As String) As String 'restituisce l'estensione di un nome di file passato come stringa If f = "" Then 'controllo se l'estensione è "" get_ext = "" Else get_ext = split(f, ".")(UBound(split(f, "."))) End If End Function Sub Unzip(ByVal zippedFileFullName As Variant, ByVal unzipToPath As Variant) 'procedura decompressione file da origine a destinazione Dim ShellApp As Object Dim sFrom As Variant Dim sTo As Variant sFrom = zippedFileFullName 'assegno file di origne sTo = unzipToPath 'assegno destinazione file decompresso Set ShellApp = CreateObject("Shell.Application") ShellApp.Namespace(sTo).CopyHere ShellApp.Namespace(sFrom).items 'copio il file decompresso da origine a destinazione End Sub
non capisco quale sia il problema.
Allegati:
You must be logged in to view attached files.luilomo wrote:non capisco quale sia il problema.
Quasi sicuramente nel file zip che viene decompresso non esiste la cartella "spedire" (come da punto n. 3)
Ho verificato.
E purtroppo la cartella spedire è presente nel file zip.
Facendo alcune indagini mi sono accorto che i nomi dei file nella cartella spedire del file zip presentano un "*".
Eliminato l'asterisco il processo sembra funzionare.
Arrivati novi file lanciati (verificato la presenza dell'asterisco)
ora fa in debug alla riga
RmDir tmp
4) Gestisco il file di origine *.zip FileCopy z, archive & "\" & fi ' lo copio in archive FileCopy z, renamed & "\" & fi & IIf(InStr(fi, ".") = 0, ".zip", "") ' lo copio in renamed con la nuova estenzione .zip Kill z 'cancello il file trattato dalla cartella di origine Kill tmp & "\spedire\*.*" ' cancello la cartella spedire in tmp RmDir tmp & "\spedire" Next 'passo al successivo file RmDir tmp MsgBox "Procedura terminata con successo" & vbNewLine & vbNewLine & "- " & nfilez & " - files zip elaborati" & vbNewLine & "- " & nfilet & " - smistati in: " & vbNewLine & vbNewLine & sPath1 & vbNewLine & vbNewLine & " Ora procedere con le altre azioni.", vbInformation Else MsgBox "PROCEDURA ANNULLATA", 0 + 64, "Download Files" Exit Sub End If
Questo potrebbe accadere perchè tra Kill tmp e RmDir tmp non passa sufficiente tempo (la rimozione della cartella non avviene se nella cartella ci son dei file). Bisogna mettere una pausa tra Kill e RmDir (per esempio una piccola Sleep).
ho un problema.
Lnciando sia la prima che la seconda macro del foglio a volte capita che il file si chiuda o che excel non risponde.
Può essere un problema di risorse che nei vari cicli seleziona rinomina copia sposta etc... siano ad un certo punto insufficienti?
Posso fare in modo da avere sempre un azzeramento di eventuali dati salvati nella memoria così da evitare rallentamenti e blocchi?
Allego excel con macro
Allegati:
You must be logged in to view attached files.Infatti io ho 16 GB di ram e un SSD.
Noto che la cosa accade se nella cartella ci sono diversi file giòa da 5-6- file zip considera che zip contiene dai 3 ai 6-7 file da smistare.
Nella seconda macro dove eseguo delle azioni apertura file selesezione area copiatura incollo splitto ect... ogni file che tratto per poi incollare i dati in un folgio unico che è nascosto "monitoraggio..." avrà circa 60 righe e 40 colonne.
Potrebbe essere il problema di scoprire e nascondere e le operazioni accessorie tipo aggiorna tutto dato checi sono anche delle pivot?
Che test potrei fare?
Le pivot sono comunque degli oggetti che mantengono in memoria area dati e operazioni di filtro che impegnano memoria, non processore. Non mi sembra che ci siano spostamenti di copia e incolla di grandi range. Le copie riguardano operazioni di copia file e sono sincrone, quindi ogni operazione attende che abbia finito quella precedente.
Io se fosse per me o per lavoro costruirei una banale funzione di log, cioè una funzioncina che semplicemente scrive su un file di testo data ora e operazione, mettendo poi dei punti di monitoraggio prima delle azioni critiche o lunghe.
Cioè: la funzione deve essere richiamata passandole una stringa di testo. La funzione apre (in append) un file di testo in una posizione determinata, ci scrive la riga di messaggio con il timestamp e lo chiude. prima di, che so, apertura zip, chiamo la funzione [esempio: scrivilog("sto per aprire file zip")]. Poi se succede qualcosa fermo tutto e controllo il file di log per vedere dove si è verificato il blocco.
Ok ho capito la logica del log ma non saprei come fare a livello di codice e dove inserirlo.
Potreste guidarmi?
Dunque, una semplice funzione di log potrebbe essere questa; supponiamo di avere a disposizione la cartella C:\LOG; in un modulo inseriamo il codice:
Function WriteLOG(txt as string) Const LogFile As String = "C:\LOG\LOGFILE.LOG" Dim FileNum As Integer FileNum = FreeFile Open LogFile For Append As #FileNum Print #FileNum, Now & ": " & txt Close #FileNum End Function
Ora possiamo richiamarlo in qualunque punto del codice, prima di qualsiasi azione di cui vogliamo tener traccia, chiamando la funzione e specificando un breve testo descrittivo. Se il file LOGFILE.LOG non esiste, viene creato. Se esiste, i dati nuovi vi vengono aggiunti (non perdiamo il contenuto precedente).
Prendo uno spezzone del tuo codice:
4) Gestisco il file di origine *.zip FileCopy z, archive & "\" & fi ' lo copio in archive FileCopy z, renamed & "\" & fi & IIf(InStr(fi, ".") = 0, ".zip", "") ' lo copio in renamed con la nuova estenzione .zip Kill z 'cancello il file trattato dalla cartella di origine
Potrebbe diventare così:
4) Gestisco il file di origine *.zip WriteLOG("Sto per copiare " & z & " in archive\" & fi) FileCopy z, archive & "\" & fi ' lo copio in archive WriteLOG("Sto per copiare " & z & " in renamed\" & fi & " con estensione zip") FileCopy z, renamed & "\" & fi & IIf(InStr(fi, ".") = 0, ".zip", "") ' lo copio in renamed con la nuova estenzione .zip WriteLOG("Sto per cancellare il il file " & z ) Kill z 'cancello il file trattato dalla cartella di origine
-
AutoreArticoli