[RISOLTO] Ricerca in più sottocartelle

[mickym1973Partecipante 7 Maggio 2018 alle 16:00 Post totali: 51]

#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 1 anno, 10 mesi fa da  sid.
• Questo argomento è stato modificato 1 anno, 3 mesi fa da  sid.

[BySalvAmministratore del forum 8 Maggio 2018 alle 9:05 Post totali: 624]

#5784

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 

il link al file

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

 

 

 

[mickym1973Partecipante 8 Maggio 2018 alle 13:30 Post totali: 51]

#5789

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.

[sidModeratore 9 Maggio 2018 alle 19:25 Post totali: 726]

#5793

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

[mickym1973Partecipante 9 Maggio 2018 alle 22:57 Post totali: 51]

#5794

ok grazie 1000.

Buona serata.

[sidModeratore 10 Maggio 2018 alle 17:51 Post totali: 726]

#5795

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

[mickym1973Partecipante 10 Maggio 2018 alle 21:56 Post totali: 51]

#5796

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.

[sidModeratore 10 Maggio 2018 alle 22:50 Post totali: 726]

#5797

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 1 anno, 10 mesi fa da  sid.
• Questa risposta è stata modificata 1 anno, 10 mesi fa da  sid.

[mickym1973Partecipante 11 Maggio 2018 alle 13:10 Post totali: 51]

#5803

Ciao Sid, funziona benissimo….ottima soluzione.

Grazie 1000 e buona giornata.

[sidModeratore 11 Maggio 2018 alle 15:27 Post totali: 726]

#5804

Grazie del risocntro; alla proxima, ciao.

[Autore]

Articoli