Home › Forum › Domande su Excel VBA e MACRO › [RISOLTO] Ricerca in più sottocartelle
Tag: Sposta file
-
AutoreArticoli
-
#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
-
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
-
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.
-
ok grazie 1000.
Buona serata.
-
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
-
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.
-
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 ? -
Ciao Sid, funziona benissimo….ottima soluzione.
Grazie 1000 e buona giornata.
-
AutoreArticoli
La discussione ‘[RISOLTO] Ricerca in più sottocartelle’ è chiusa a nuove risposte.