Sviluppare funzionalita su Microsoft Office con VBA Estrarre file da archivi zip e smistarli in cartelle specifiche

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 58 totali)
  • Autore
    Articoli
  • #7066 Score: 0 | Risposta

    luilomo
    Partecipante

      Salve,

      ecco il quesito:

      Ho dei file in una cartella C:\Users\User\Documents\esempio

      Alcuni potrebbero non avere estensione e devo quindi rinominarli con "nomefile.zip" 

      Successivamente devo aprire ogni singolo .zip, al cui interno c'è una cartella "spedire", e smistare i file in cartelle specifiche in base all'estensione del file

      Esempio:

      Cartella XLS file *.xls;

      Cartella PDF file *.pdf;

      Cartella CSV sile *.csv;

      Cartella MEDIA tutti gli altri file con varie estensioni (*.*)

      Aggiungo anche la necessità di archiviare lo zip trattato in una cartella specificha esempio "C:\..\trattati"

      Ho provato con del codice della discussione in cui si parla di unzip ma non riesco a risolvere il mio cso che è un pò più complesso.

      Ho notato che se nel nome dei file negli zip che arrivano da un disposito android se è presente * unzip non li legge e nella unzip non trovo nessun file

       

      Allego uno zip con dentro tre file senza estensione come li troverei nella cartella

      Allegati:
      You must be logged in to view attached files.
      #7068 Score: 0 | Risposta

      vecchio frac
      Senior Moderator
        238 pts

        Questa discussione è un duplicato di quella precedente o ci sono informazioni diverse? avresti potuto/dovuto continuare la discussione già aperta

        #7069 Score: 0 | Risposta

        luilomo
        Partecipante

          Buongirno,

          grazie per la precisazione

          Specifico che ci sono informazioni diverse come:

          più file zip da decomprimere in un ciclo, rinominare i file di origine con *.zip, smistare i file dei vari zip in cartelle specifiche in base all'estensione.

          Aggiungo anche la necessità di archiviare lo zip trattato in una cartella specificha esempio "C:\..\trattati"

          Luigi

           

          #7070 Score: 1 | Risposta

          vecchio frac
          Senior Moderator
            238 pts

            Ok, ma quando parlavo di duplicato della discussione, intendevo dire quella che hai aperto in questo forum poco prima di questa... non parlavo del vecchio thread che hai trovato nello storico 🙂

            Probabilmente è meglio se chiudo l'altra discussione così non facciamo confusione con le risposte.

            #7071 Score: 0 | Risposta

            luilomo
            Partecipante

              Yes

              avevo avuto di problemi con il browser

              sorry

              🙄 

              #7072 Score: 0 | Risposta

              vecchio frac
              Senior Moderator
                238 pts

                Per il tuo problema, nel merito, poichè confermi che i file zippati senza estensione sono a loro volta zippati, credo di aver capito che devi estrarli e rinominarli, quindi dezipparli e spostare i file al loro interno delle cartelle definite dall'estensione.

                Infine copiare lo zip di partenza nella cartella che hai indicato.

                E' così?

                #7074 Score: 0 | Risposta

                luilomo
                Partecipante

                  La struttura è questa

                  Cartella origine -> contiene file (zip) alcuni senza estensione a cui mettere estensione .zip

                  Aprire tutti i singoli nella cartella origine che ora hanno l'estenzione *.zip

                  Smistare i file contenuti nei diversi zip in base alla loro estensione in cartelle specifiche 

                  Spostare i file zip elaborati in una cartella archivio.

                  Luigi

                  #7075 Score: 0 | Risposta

                  albatros54
                  Moderatore
                    81 pts

                    copia questo codice in un modulo di un file di excel,il file cosi creato lo inserisci nella cartella dei file che tu vuoi zippare, lanciando il codice ti rinomina i file senza estenzione in file.zip, per il momento questo...il seguito poi.

                     Option Explicit
                    Public Sub mettiZip()
                    
                    
                        Dim wkMe As Workbook
                        Dim sPath As String
                        Dim sFileName As String, ext As String
                        Dim nome1 As String, filet As String
                    
                    
                        Set wkMe = ThisWorkbook
                        sPath = wkMe.Path & "\"
                        sFileName = Dir(sPath)
                        ext = ".zip"
                        Do While (Len(sFileName) > 0)
                            If sFileName <> wkMe.Name Then
                                If Right(sFileName, 4) = ".zip" Then
                                    ' MsgBox " File con estensione zip"
                                Else
                                    '  MsgBox "File senza estensione"
                                    filet = sFileName
                                    nome1 = CStr(filet) & ext
                                    Name sPath & filet As sPath & nome1
                                End If
                            End If
                            sFileName = Dir
                        Loop
                    End 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 )
                    #7076 Score: 0 | Risposta

                    vecchio frac
                    Senior Moderator
                      238 pts

                      Questa è la mia proposta.

                      Tutto il codice in un modulo, da lanciare la sub principale manage_zips.

                      Il codice ti fa scegliere la cartella in cui ci sono i file (zip e apparentemente non zip), prende ogni file zippato e ne estrae il contenuto in una cartella temporanea, analizza ogni file di questa cartella temporanea e in base all'estensione lo sposta in una cartella dedicata.

                      Il codice crea le cartelle temporanee e definitive se non esistono. Attenzione che è distruttivo sulla cartella TMP quindi bada di non averne già una con lo stesso nome.  Ho messo percorsi miei di test sulla mia macchina, tu devi cambiare questi percorsi rispettando i nomi delle cartelle.

                      Se ogni file zip contiene la subcartella "spedire"; il codice funziona senza problemi. Casi speciali non li o ho trattati 🙂

                      Option Explicit
                      
                      
                      Sub manage_zips()
                      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
                      
                      Const archive As String = "c:\users\franz\desktop\ARCHIVE"
                      Const tmp As String = "c:\users\franz\desktop\TMP"
                      Const smista As String = "c:\users\franz\desktop\SMISTA"
                      
                          Set fd = Application.FileDialog(msoFileDialogFolderPicker)
                          fd.Title = "Seleziona la cartella con i file da esaminare"
                          fd.InitialFileName = "c:\users\franz\desktop\test\"
                          v = fd.Show
                          If v = False Then Exit Sub
                          
                          Set fso = CreateObject("Scripting.FileSystemObject")
                          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(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"
                          
                          For Each f In fso.getfolder(fd.SelectedItems(1)).Files
                              z = f.Path
                              fi = f.Name
                              If get_ext(f.Path) <> "zip" Then
                                  Name f.Path As f.Path & ".zip"
                                  z = z & ".zip"
                              End If
                                      
                              Unzip z, tmp
                                       
                              For Each f2 In fso.getfolder(tmp & "\spedire").Files
                                  s = LCase(get_ext(CStr(f2)))
                                  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 & "\" & f.Name
                              Next
                                     
                              FileCopy z, archive & "\" & fi
                              Kill tmp & "\spedire\*.*"
                              RmDir tmp & "\spedire"
                          Next
                          RmDir tmp
                          MsgBox "Fatto."
                      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
                              get_ext = ""
                          Else
                              get_ext = Split(f, ".")(UBound(Split(f, ".")))
                          End If
                      End Function
                      
                      Private Sub Unzip(ByVal zippedFileFullName As Variant, ByVal unzipToPath As Variant)
                      Dim ShellApp As Object
                      Dim sFrom As Variant
                      Dim sTo As Variant
                      
                          sFrom = zippedFileFullName
                          sTo = unzipToPath
                      
                          Set ShellApp = CreateObject("Shell.Application")
                          ShellApp.Namespace(sTo).CopyHere ShellApp.Namespace(sFrom).items
                      End Sub
                      

                      (la sub Unzip non è mia ma l'ho trovata in giro e adattata)

                      #7077 Score: 0 | Risposta

                      luilomo
                      Partecipante

                        Ciao Vecchio Frac

                        ho seguito le istruzioni ma va in debug alla riga evidenziata

                        Case Else
                        v = smista & "\ALTRI"
                        End Select
                        FileCopy f2.Path, v & "\" & f.Name
                        Next

                        ecco le modifiche per le cartelle

                        Const archive As String = "C:\Users\User\Desktop\ARCHIVE"
                        Const tmp As String = "C:\Users\User\Desktop\TMP"
                        Const smista As String = "C:\Users\User\Desktop\SMISTA"
                        
                            Set fd = Application.FileDialog(msoFileDialogFolderPicker)
                            fd.Title = "Seleziona la cartella con i file da esaminare"
                            fd.InitialFileName = "C:\Users\User\Desktop\TEST\"
                        
                        #7078 Score: 0 | Risposta

                        vecchio frac
                        Senior Moderator
                          238 pts

                          Uhm, e che errore dà? Se va "in debug" mi aspetto un messaggio di errore... numero e descrizione. Una possibilità è che "v" non sia valorizzata ma è strano stante il Case Else. 

                          #7079 Score: 0 | Risposta

                          luilomo
                          Partecipante

                            Errore di run.time '75'

                            Errore di accesso al percorso/file

                            ma adesso qui

                            For Each f In FSO.getfolder(fd.SelectedItems(1)).Files
                            z = f.Path
                            fi = f.Name
                            If get_ext(f.Path) <> "zip" Then
                            Name f.Path As f.Path & ".zip"
                            z = z & ".zip"
                            End If

                            Unzip z, tmp

                            #7080 Score: 0 | Risposta

                            vecchio frac
                            Senior Moderator
                              238 pts

                              Non dovrebbe... nella seconda segnalazione il ciclo scorre i file presenti nella cartella scelta, ne conserva nome e percorso (in "z") e nome senza percorso (in "fi"), quindi verifica che il file termini con ".zip": se non è così rinomina il file aggiungendovi ".zip". 

                              Ho riprovato creando le condizioni iniziali e a me funziona senza intoppi.

                              Descrivimi lo scenario in cui esegui il test.

                              #7081 Score: 0 | Risposta

                              luilomo
                              Partecipante

                                Grazie Albatros

                                Sul tuo codice ho fatto delle modifche sviluppi e correzioni.

                                attendo il seguito. 😉

                                Nella versione di Albatros tutti i file senza estensione o con estensione difersa da .zip venivano trattati con l'aggiunta di .zip

                                La modifica permette di selezionare la cartella in cui si trovano i file e gestisto qualche cmportamento dell'utente con messaggi

                                La correzione aggiunge l'estensione .zip solo ai file senza estensione (esempio topolino) se il file ha una qualche estensione .* la procedura non fa nulla. 

                                Premetto che sono un principiante e cerco di interpretare e sviluppare il codice dato da altri.

                                Option Explicit
                                Public Sub mettiZip()
                                
                                
                                    Dim wkMe As Workbook
                                    Dim sPath As String
                                    Dim sFileName As String, ext As String
                                    Dim nome1 As String, filet As String
                                    Dim FSO As Object
                                    Dim ext1 As Long
                                    Dim a As String
                                    '--------------------------------------------------
                                    ' inizio codice gestione form per scelta cartella di origine
                                        With Application.FileDialog(msoFileDialogFolderPicker) ' apertura form selezione cartella di orgine
                                            .Title = "Seleziona la cartella di ORIGINE con i file da elaborare" ' assegnazione titolo pop up
                                            .ButtonName = "Seleziona" ' testo bottone di scelta
                                            .InitialFileName = "\Seleziona origine" 'assegnazione cartella iniziale
                                            
                                                If .Show = -1 Then ' se si preme OK
                                                    sPath = .SelectedItems(1)
                                                    
                                                    ElseIf sPath = "Seleziona origine" Then
                                                    
                                                    Else
                                                    ext1 = 1 ' se si si annulla
                                                    MsgBox "Nessuna cartella di origine selezionata" & vbNewLine & " i file non verranno elaborati", vbCritical
                                                End If
                                                If sPath = "C:\" Then 'verifico se è stato premuto ok ma cancellando selezione origine
                                                    ext1 = 1
                                                    MsgBox "Nessuna cartella di origine selezionata" & vbNewLine & " i file non verranno elaborati", vbCritical
                                                End If
                                        End With 'esco dalla procedura
                                        If ext1 <> 1 Then 'se si è premuto ok
                                        sPath = sPath & "\"
                                    Set wkMe = ThisWorkbook
                                    'sPath = sPath & "\"
                                    sFileName = Dir(sPath)
                                    ext = ".zip"
                                    Do While (Len(sFileName) > 0)
                                        If sFileName <> wkMe.Name Then
                                        a = Right(sFileName, 4)
                                            If Right(sFileName, 4) = "." Like "*" Then ' solo i file senza estensione vengono trattati
                                            
                                                ' MsgBox " File con estensione zip"
                                            Else
                                                '  MsgBox "File senza estensione"
                                                filet = sFileName
                                                nome1 = CStr(filet) & ext
                                                Name sPath & filet As sPath & nome1
                                            End If
                                        End If
                                        sFileName = Dir
                                    Loop
                                    End If
                                
                                End Sub
                                
                                #7082 Score: 0 | Risposta

                                vecchio frac
                                Senior Moderator
                                  238 pts

                                  Io ho rifatto il test e funziona bene, solo una leggera modifica che non c'entra con quanto lamentato, dopo End Select la riga

                                  FileCopy f2.Path, v & "\" & f.Name

                                  va corretta in 

                                  FileCopy f2.Path, v & "\" & f2.Name

                                  altrimenti viene ricopiato il file zip e non il file contenuto.

                                  Per il resto la mia procedura funziona bene, e questo lo scenario: una cartella test sul desktop, i file zippati lì dentro, avvio la macro, scelgo la cartella di test. Fatto: al termine trovo sul desktop la cartella ARCHIVE con i file originali muniti di estensione zip se non l'avevano e la cartella SMISTA con al suo interno le cartelle WORD, EXCEL, eccetera e al loro interno i file appropriati.

                                  #7083 Score: 0 | Risposta

                                  luilomo
                                  Partecipante

                                    <em class="bbp-the-quote-cite">vecchio frac wrote:</em>Non dovrebbe... nella seconda segnalazione il ciclo scorre i file presenti nella cartella scelta, ne conserva nome e percorso (in "z") e nome senza percorso (in "fi"), quindi verifica che il file termini con ".zip": se non è così rinomina il file aggiungendovi ".zip". 

                                    __________________________________

                                    Ecco lo scenario

                                    cartella in cui ho meeso i file che ti allego e il file xlsm

                                    C:\Users\User\Desktop\TEST

                                    nessuna cartella ulteriore all'interno solo i file due senza estensione uno .zip

                                    Lancio la sub seleziono la cartella TEST e arriva l'errore

                                    Erroore di run-time '53'

                                    Impossibile trovare il file.

                                    con il debug

                                    FileCopy f2.Path, v & "\" & f.Name

                                    nel frattempo nella cartella TEST 

                                    in SMISTA si sono create le cartelle ALTRI , EXCEL, PDF, TEXT, WORD,

                                    ma al loro interno, ad esclusione di WORD, trovo un file "mieidati1 (1).zip" che il sistema non riconosce come archivio perchè mi da errore in apertura con unzip.

                                    in TMP trovo cartella "spedire" con dentro i files dell'archivio di origine del file "mieidati1 (2).zip"

                                    in ARCHIVE trovo solo un file zip dal nome "mieidati1 (1).zip" che riesco ad aprire con unzip

                                    Allego i files

                                    i (2) e (3) nel mio test sono quelli senza estensione

                                     

                                     

                                    Allegati:
                                    You must be logged in to view attached files.
                                    #7088 Score: 0 | Risposta

                                    vecchio frac
                                    Senior Moderator
                                      238 pts

                                      Togli testing.xlsm dalla cartella test e lancialo da fuori. 

                                      Anche i file Excel sono file zippati, forse la procedura tenta di riconoscerlo come zippato ma non trova al suo interno la cartella "spedire" (in ogni file zippato c'è la cartella "spedire" vero?)

                                      Ci siamo comunque accavallati con le risposte, leggi l'ultima mia prima della tua con la piccola correzione descritta.

                                      #7092 Score: 0 | Risposta

                                      vecchio frac
                                      Senior Moderator
                                        238 pts

                                        vecchio frac wrote:Togli testing.xlsm dalla cartella test e lancialo da fuori. 

                                        Ho fatto la prova lanciando la macro dal file di test dentro la cartella di test, e non va bene infatti. La macro tenta di rinominare il proprio file e ovviamente non ci riesce perchè è in esecuzione. Quindi toglilo da lì e avvia il file di test.xlsm fuori dalla cartella dove devi pescare i file zippati.

                                        Se vuoi si può implementare un controllo sui file non zip per ignorarli.

                                        (Ogni tanto la macro fallisce tentando di rimuovere la cartella TMP dal desktop, perchè è troppo veloce, si può ovviare inserendo una brevissima attesa prima di dare il comando finale "RmDir tmp")

                                        #7093 Score: 0 | Risposta

                                        luilomo
                                        Partecipante

                                          <em class="bbp-the-quote-cite">vecchio frac wrote:</em>Togli testing.xlsm dalla cartella test e lancialo da fuori. 

                                          Ipotesi corretta,

                                          confermo che con la correzione 

                                          dopo End Select la riga

                                          FileCopy f2.Path, v & "\" & f.Name

                                          va corretta in 

                                          FileCopy f2.Path, v & "\" & f2.Name

                                          e spostando il file .xlms fuori dalla cartella in cui ci sono i file da elaborare tutto gira come dovrebbe.

                                           

                                          Una sola cosa ma migliorare spostare i file rinominati in una cartella diversa " RENAME" da quella in cui erano in origine così nella cartella TEST ci saranno solo i file da trattare.

                                          😉 🙂 

                                           

                                          #7094 Score: 0 | Risposta

                                          vecchio frac
                                          Senior Moderator
                                            238 pts

                                            luilomo wrote:spostare i file rinominati in una cartella diversa " RENAME" da quella in cui erano in origine

                                            Non è quello che succede già? i file rinominati (cioè con l'aggiunta di .zip se non c'era) li trovi in ARCHIVE.

                                            Forse non ho capito la domanda 🙂

                                            #7095 Score: 0 | Risposta

                                            vecchio frac
                                            Senior Moderator
                                              238 pts

                                              Aspetta, il codice in effetti sposta in ARCHIVE i file originali, con o senza estensione zip.

                                              Se vuoi si può creare una nuova cartella in cui depositare i file rinominati con .zip

                                              #7096 Score: 0 | Risposta

                                              vecchio frac
                                              Senior Moderator
                                                238 pts

                                                Ho fatto la modifica, adesso ti ritrovi una nuova cartella chiamata RENAMED che contiene gli originali file zippati, tutti con l'estensione .zip.

                                                Il codice completo è:

                                                Option Explicit
                                                
                                                Sub manage_zips()
                                                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
                                                
                                                Const archive As String = "c:\users\franz\desktop\ARCHIVE"
                                                Const tmp As String = "c:\users\franz\desktop\TMP"
                                                Const smista As String = "c:\users\franz\desktop\SMISTA"
                                                Const renamed As String = "c:\users\franz\desktop\RENAMED"
                                                
                                                    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
                                                    fd.Title = "Seleziona la cartella con i file da esaminare"
                                                    fd.InitialFileName = "c:\users\franz\desktop\test\"
                                                    v = fd.Show
                                                    If v = False Then Exit Sub
                                                    
                                                    Set fso = CreateObject("Scripting.FileSystemObject")
                                                    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"
                                                    
                                                    For Each f In fso.getfolder(fd.SelectedItems(1)).Files
                                                        z = f.Path
                                                        fi = f.Name
                                                        If get_ext(f.Path) <> "zip" Then
                                                            Name f.Path As f.Path & ".zip"
                                                            z = z & ".zip"
                                                        End If
                                                                
                                                        Unzip z, tmp
                                                                 
                                                        For Each f2 In fso.getfolder(tmp & "\spedire").Files
                                                            s = LCase(get_ext(CStr(f2)))
                                                            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
                                                               
                                                        FileCopy z, archive & "\" & fi
                                                        FileCopy z, renamed & "\" & fi & IIf(InStr(fi, ".") = 0, ".zip", "")
                                                        Kill tmp & "\spedire\*.*"
                                                        RmDir tmp & "\spedire"
                                                    Next
                                                    RmDir tmp
                                                    MsgBox "Fatto."
                                                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
                                                        get_ext = ""
                                                    Else
                                                        get_ext = Split(f, ".")(UBound(Split(f, ".")))
                                                    End If
                                                End Function
                                                
                                                Sub Unzip(ByVal zippedFileFullName As Variant, ByVal unzipToPath As Variant)
                                                Dim ShellApp As Object
                                                Dim sFrom As Variant
                                                Dim sTo As Variant
                                                
                                                    sFrom = zippedFileFullName
                                                    sTo = unzipToPath
                                                
                                                    Set ShellApp = CreateObject("Shell.Application")
                                                    ShellApp.Namespace(sTo).CopyHere ShellApp.Namespace(sFrom).items
                                                End Sub
                                                #7097 Score: 0 | Risposta

                                                luilomo
                                                Partecipante

                                                  Super.

                                                  Vedo se riesco a capire il codice e ad apprendere qualcosa in piu.

                                                   

                                                   

                                                  #7101 Score: 0 | Risposta

                                                  luilomo
                                                  Partecipante

                                                    Ciao vecchio frac

                                                    ecco il nostro lavoro.

                                                    Cosa ne dici?

                                                    Commentato i cui ho gestito alcuni messaggi per l'utente.

                                                    In questa versione non 'cè bisogno di cambiare le destinazioni delle cartelle nelle costanti.

                                                    Si creano automaticamente a partire dalla posizione del file xlms all'interno di una cartella dati.

                                                    ;-

                                                    Ora lo devo integrare in un altro codice.

                                                    Option 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 sPath 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
                                                        'e ai Fogli Storico e Importati
                                                        Set wkMe = ThisWorkbook
                                                        'Set shMe1 = wkMe.Worksheets("Monitoraggio sicurezza Ambienti")
                                                        'Set shMe2 = wkMe.Worksheets("Verifiche")
                                                        
                                                        'metto nella variabile il percorso di questo file
                                                        sPath = wkMe.path & "\DATI"
                                                        
                                                        'impedisco lo *sfarfallio* del monitor
                                                        Application.ScreenUpdating = False
                                                    
                                                    
                                                    archive = sPath & "\ARCHIVE"  'percorso cartelle che se non presenti verranno create
                                                    tmp = sPath & "\TMP" 'percorso cartelle che se non presenti verranno create
                                                    smista = sPath & "\SMISTA" 'percorso cartelle che se non presenti verranno create
                                                    renamed = sPath & "\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 con i file da elaborare"
                                                        fd.InitialFileName = "C:\Users\User\Desktop\TEST\test\" 'percorso iniziale da presentare all'utente
                                                        v = fd.Show
                                                        If v = False Then Exit Sub
                                                        
                                                    '''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(sPath) Then MkDir sPath
                                                        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"
                                                     'sPath = 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 & sPath & vbNewLine & vbNewLine & " Ora procedere con le altre azioni.", vbInformation
                                                    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
                                                    
                                                    
                                                    #7102 Score: 0 | Risposta

                                                    vecchio frac
                                                    Senior Moderator
                                                      238 pts

                                                      Ho visto le tue modifiche, ottimo lavoro 😀 (pollice su)

                                                      L'unica osservazione su un tuo commento:

                                                      z = z & ".zip" ' se <> da zip e = a "" inserisco estesione .zip

                                                      Qui non è che se l'estensione è diversa da "zip"ed è uguale a "" (vuoto) allora inserisco "zip": l'If precedente dice solo If get_ext(f.path) <> "zip"

                                                      perciò l'estensione zip viene aggiunta se l'estensione originale non è questa; per dire, se avessi un file chiamato "pippo.bla" e se fosse riconosciuto come un file zippato, verrebbe rinominato con "pippo.bla.zip".

                                                      Per il resto complimenti 😉

                                                    Login Registrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 58 totali)
                                                    Rispondi a: Estrarre file da archivi zip e smistarli in cartelle specifiche
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni: