You are here:--[RISOLTO[ Ricerca in più sottocartelle
[RISOLTO[ Ricerca in più sottocartelle 2018-05-11T15:28:30+00:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO[ Ricerca in più sottocartelle

  • Autore
    Articoli
  • mickym1973
    Partecipante
      Post totali: 47
      #5780 |

      Ciao Sid, perdona ma mi sono accorto che nel post chiuso l’altro ieri (individuazione di file in sottocartelle e copia in una nuova), la ricerca dei file dovrebbe avvenire anche nelle eventuali sottocartelle del percorso C:\ARCHIVIO\CARTELLAx, mentre ho notato che ora se un file è ad esempio nel percorso seguente: C:\ARCHIVIO\CARTELLA2\SUBCARTELLA2, il programma non me lo trova anche se il file c’è, in quanto termina la ricerca al livello CARTELLA2 e non va a vedere anche dentro alla cartella SUBCARTELLA2.

      E’ possibile introdurre anche la ricerca ad un livello inferiore di cartelle?

      Grazie 1000

      • Questo argomento è stato modificato 5 mesi, 1 settimana fa da sid sid.
    • BySalvBySalv
      Amministratore del forum
        Post totali: 283

        Ciao torniamo al file che ti ho proposto, e lo aggiorniamo per il trasferimento dei file, questa la macro per lo spostamento dei file

        Sub Sposta() 'spostafile
        Dim Odd, Nww, r, x, d, ind, ind1, est, risp
        
        ind1 = Cells(2, 1)
        If Cells(4, 1) = "" Then Exit Sub Else r = Cells(Rows.Count, 2).End(xlUp).Row
        For x = 4 To r
        ind = Cells(x, 1)
        d = Cells(x, 2)
        Odd = ind & d
        Nww = ind1 & d
        Name Odd As Nww
        1 Next x
        MsgBox "Spostamento Effettuato", vbInformation, "Spostamento file"
        End Sub

        Come funziona, non mettere la scrittura del Collegamenti e link alle celle quindi “NO”.

        fai la ricerca, scegliendo la cartella con il doppio click in “A2”, vede anche nelle sottocartelle tutte, partendo dalla cartella che hai scelto, a questo punto hai il tuo elenco dei file fai una scelta elimina dall’elenco quelli che non vuoi spostare, tutta la riga.

        alla fine avrai solo l’elenco dei file da spostare, a questo punto ancora doppio click in “A2” e scegli la cartella dove vuoi spostare i file, una volta scelta la cartella premi sul pulsante “Sposta” ed i file saranno spostati tutti nella cartella scelta, tutto qui.

        Ho aggiornato il file spostando anche i pulsanti.

        Ciao By Sal  :bye:

        il link al file

        https://mega.nz/#!tUEhzIyK!sWAlVAnsWulZ0Fubh05O7ZYFa3-Kv9fLYVBj-wTbJdA

         

         

         

      • mickym1973
        Partecipante
          Post totali: 47

          Ciao Bysalv, grazie 1000 per il tuo aiuto, ho provato il tuo file però purtroppo ho riscontrato due problemi:

          1) una volta schiacciato il pulsante “cerca” lui mi trova tutti i file presenti nella cartella che gli ho indicato io e in tutte le sottocartelle, invece vorrei dargli io la lista di file che mi deve trovare, altrimenti  la colonna “nome file” verrà popolata da migliaia di file e poi devo cancellare manualmente tutte le righe meno quelle dei file che voglio tenere (sarebbe un lavoro abnorme, poichè sto lavorando su un archivio che ha più di 3000 cartelle).Il codice di Sid andava benissimo, bisognerebbe solo aggiungere l’istruzione di ricerca anche nelle sottocartelle ad un livello più basso.

          2) nel momento in cui indico la cartella di destinazione dei file, il programma mi dà comunque un errore “errore di accesso al percorso file”.

          Grazie 1000 e buona giornata.

        • sidsid
          Moderatore
            Post totali: 376

            Per ciclare tutte le cartelle e subcartelle su più livelli, occorre una routine ricorsiva.
            Da qualche parte devo avere qualcosa al riguardo.
            Appena ho modo ti faccio sapere

          • mickym1973
            Partecipante
              Post totali: 47

              ok grazie 1000.

              Buona serata.

            • sidsid
              Moderatore
                Post totali: 376

                Ciao
                Queste 2 routine (macro + function) da inserire nello stesso modulo
                (attivare sempre la libreria MICROSOFT SCRIPTING RUNTIME)

                Sub COPIA_FILE()
                Dim ws1 As Worksheet
                Dim sPath1 As String, sPath2 As String, sLista As String, sFile1 As String
                Dim nUltimaRiga As Long, nRiga As Long
                Dim bEsiste As Boolean
                Set ws1 = Sheets("Foglio1") 'nome tuo foglio
                sPath1 = "C:\ARCHIVIO"
                sPath2 = "C:\NEW"
                nUltimaRiga = IIf(ws1.Range("B2") = vbNullString, 1, ws1.Range("B" & Rows.Count).End(xlUp).Row)
                
                If nUltimaRiga > 1 Then
                    For nRiga = 2 To nUltimaRiga
                        sFile1 = Left(ws1.Range("B" & nRiga), 9)
                        
                        Call RICORSIVA(sPath1, sPath2, sFile1, sLista, bEsiste)
                        
                        If Not bEsiste Then
                            'creo la lista dei file non presenti nelle sottocartelle
                            sLista = sLista & sFile1 & vbLf
                        End If
                
                        bEsiste = False
                    Next nRiga
                End If
                If Len(sLista) > 0 Then
                    MsgBox sLista, vbInformation, "lista file non presenti"
                End If
                
                Set ws1 = Nothing
                End Sub
                Function RICORSIVA(sPath1 As String, _
                                sPath2 As String, _
                                sFile1 As String, _
                                sLista As String, bEsiste As Boolean) As String
                
                Dim FSO As Scripting.FileSystemObject
                Dim myFolder As Scripting.Folder, MyFolderTarget As Scripting.Folder, mySubFolder As Scripting.Folder
                Dim myFile As Scripting.File
                Dim sFile2 As String
                
                Set FSO = New Scripting.FileSystemObject
                Set myFolder = FSO.GetFolder(sPath1)
                Set MyFolderTarget = FSO.GetFolder(sPath2)
                
                For Each mySubFolder In myFolder.SubFolders
                        
                    For Each myFile In mySubFolder.Files
                            sFile2 = Left(myFile.Name, 9)
                            
                            'confronto i nomi dei file
                            If StrComp(sFile1, sFile2, vbTextCompare) = 0 Then
                                bEsiste = True
                                myFile.Copy (sPath2 & "\" & myFile.Name)
                            End If
                    Next myFile
                    RICORSIVA = RICORSIVA(mySubFolder.Path, sPath2, sFile1, sLista, bEsiste)
                Next mySubFolder
                
                Set FSO = Nothing
                Set myFolder = Nothing
                Set MyFolderTarget = Nothing
                
                End Function
              • mickym1973
                Partecipante
                  Post totali: 47

                  Ciao Sid, grazie per il tuo interessamento, ho fatto qualche prova ed ho notato che il programma ora copia solo i file nelle sottocartelle, ad esempio ipotizziamo di avere questa struttura:

                  C:\ARCHIVIO\SUBCARTELLA1

                  ipotizziamo di avere i file “a.pdf” e “b.pdf” nella cartella C:\ARCHIVIO e i file “c.pdf” e “d.pdf” nella cartella C:\ARCHIVIO\SUBCARTELLA1

                  Ora, facendo girare il programma, nella cartella C:\NEW vengono copiati solo i file “c.pdf” e “d.pdf”, ovvero quelli presenti nella SUBCARTELLA1, mentre quelli presenti in C:\ARCHIVIO non vengono copiati.

                  Grazie e buona serata.

                • sidsid
                  Moderatore
                    Post totali: 376

                    Senza effettuare grandi modifiche, una soluzione indolore potrebbe essere:
                    – creare una nuova cartella in C:\ (esempio PIPPO)
                    – ci inserisci la cartella ARCHIVIO
                    – modificare l’istruzione
                    sPath1 = "C:\ARCHIVIO"
                    in
                    sPath1 = "C:\PIPPO"

                    In questo modo vengono ciclati anche i file nella cartella ARCHIVIO.
                    E’ un problema ?

                    • Questa risposta è stata modificata 5 mesi, 1 settimana fa da sid sid.
                    • Questa risposta è stata modificata 5 mesi, 1 settimana fa da sid sid.
                  • mickym1973
                    Partecipante
                      Post totali: 47

                      Ciao Sid, funziona benissimo….ottima soluzione.

                      Grazie 1000 e buona giornata.

                    • sidsid
                      Moderatore
                        Post totali: 376

                        Grazie del risocntro; alla proxima, ciao.

                      La discussione ‘[RISOLTO[ Ricerca in più sottocartelle’ è chiusa a nuove risposte.

                      Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

                      Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

                      Chiudi