Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Cercare files in una directory copiarli ed incollarli

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Cercare files in una directory copiarli ed incollarli

Postdi giubar » 07/10/16 16:58

Ciao a tutti,

dopo aver fatto una ricerca nel forum mi è sembrato di non essere riuscito a trovare la risposta al mio problema e quindi sono di nuovo qui per chiedere il vostro aiuto.
Ho creato questa macro che

Codice: Seleziona tutto
Sub Pulsante1_Click()

Dim Riga As Integer, Ncartelle As Integer
Dim Cartella As String
Dim check As Boolean

Dim FileSystemObj

Set FileSystemObj = CreateObject("Scripting.FileSystemObject")

Worksheets("SingleLoomsTotal").Activate 'Attiva il foglio "SingleLoomsTotal"
Riga = 12
check = False
Ncartelle = 0

While Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) <> ""
    If Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) Like ("*" & "IS" & "*") _
      Or Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) Like ("*" & "IT" & "*") Then     'La ricerca sarà Case Sensitive
         Cells(Riga, 8).Interior.ColorIndex = 6
          Riga = Riga + 1
          check = True
      Else
        Riga = Riga + 1
    End If
    If Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 1) <> "" _
        And Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) = "" Then
       If check Then
         Cartella = "C:\Users\Admin\Documents\perClemente\" & Cells(Riga - 1, 9)
          If Not FileSystemObj.folderExists(Cartella) Then
             FileSystemObj.CreateFolder Cartella
             Ncartelle = Ncartelle + 1
          End If
        End If
          Riga = Riga + 11
       End If
     If check Then
       Cartella = "C:\Users\Admin\Documents\perClemente\" & Cells(Riga - 1, 9)
       If Not FileSystemObj.folderExists(Cartella) Then
          FileSystemObj.CreateFolder Cartella
          Ncartelle = Ncartelle + 1
       End If
     End If
     check = False
Wend
MsgBox " Sono state create " & Ncartelle & " cartelle in C:\Users\Admin\Documents\perClemente"
End Sub


ricerca in un foglio Excel che ha una determinata struttura e qualche migliaio di righe tutte le occorrenze IS e/o IT, quando le trova evidenzia le celle e va a creare, se non esiste, una cartella con il nome RootCode. A questo punto il mio problema è che nella cartella "C:\Users\Admin\Documents\perClemente\Installativi" dovrei andare a cercare tutti i files contenenti nel loro nome il codice RootCode (es. ___K2943000-801_agbya_jjj.cgm" copiarli ed incollarli nella cartella "C:\Users\Admin\Documents\perClemente\K2943000-801" appena creata e così via.
La mia idea era quella che appena creava la cartella eseguisse la ricerca dei file li copiasse e li incollasse nella cartella appena creata.
Pensate che la cosa sia fattibile? Ho provato ad usare il metodo FSO con FileExists, ma non essendo neofita e non molto pratico purtroppo non sono riuscito.
Spero di essere stato chiaro
Grazie
giubar
giubar
Newbie
 
Post: 8
Iscritto il: 18/09/16 18:53

Sponsor
 

Re: Cercare files in una directory copiarli ed incollarli

Postdi Anthony47 » 08/10/16 01:02

Alcune cose si possono capire solo decodificando la macro; al meglio di quanto ho capito io, dovresti aggiungere nel tuo codice le due righe marcate ***, probabilmente in due posizioni:
Codice: Seleziona tutto
       If check Then
         Cartella = "C:\Users\Admin\Documents\perClemente\" & Cells(Riga - 1, 9)
          If Not FileSystemObj.FolderExists(Cartella) Then
             FileSystemObj.CreateFolder Cartella
             Ncartelle = Ncartelle + 1
          End If
        pbase = "C:\Users\Admin\Documents\perClemente\Installativi"               '***
        FileSystemObj.CopyFile pbase & "*" & Cells(Riga - 1, 9) & "*", Cartella   '***
        End If

NB: eventuali file gia' presenti nella directory di destinazione saranno sovrascritti.
Sei sicuro che vuoi "Copiare" e non "Spostare" i file?

Fai sapere...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cercare files in una directory copiarli ed incollarli

Postdi giubar » 08/10/16 10:22

Ciao Anthony47,

allora la soluzione proposta pare funzionare anche se ho dovuto aggiungere uno "\" alla fine del percorso, per evitare un errore di run time 53 "file non trovato", per intenderci:

Codice: Seleziona tutto
pbase = "C:\Users\Admin\Documents\perClemente\Installativi\"               '***


Alla tua domanda
Sei sicuro che vuoi "Copiare" e non "Spostare" i file?

rispondo SI perché la cartella che contiene tutti i file non la posso modificare.
In pratica il file Excel è una lista di un esploso di pezzi che compongono vari assiemi rappresentati dal codice della cartella che creo (leggo questo codice in colonna 9) ed ogni volta che trovo l'occorrenza "IS" e/o "IT" vado a leggere il relativo codice del pezzo (colonna 2 che ho corretto), vado a trovare il relativo disegno nella cartella Installativi e lo copio nella cartella creata (così da avere ad esempio la cartella assieme motore con tutti i disegni costituenti questo assieme).
Mi sono reso conto però che devo modificare il codice perché leggevo in colonna 9 e non in colonna 2. :oops: :oops: :oops:
Purtroppo essendo un neofita e non un programmatore sicuramente il codice può essere ottimizzato, ma per il momento sarà sufficiente che svolga il suo lavoro ;)
se dovessi essere ancora in difficoltà vengo a bussare nel forum :)
Grazie
Giubar
giubar
Newbie
 
Post: 8
Iscritto il: 18/09/16 18:53

Re: Cercare files in una directory copiarli ed incollarli

Postdi giubar » 08/10/16 13:04

Ciao Anthony47,

di seguito la versione credo definitiva

Codice: Seleziona tutto
Sub Pulsante1_Click()

Dim Riga As Integer, Ncartelle As Integer
Dim Cartella As String, pbase As String
Dim check As Boolean

Dim FileSystemObj

Set FileSystemObj = CreateObject("Scripting.FileSystemObject")

Worksheets("SingleLoomsTotal").Activate 'Attiva il foglio "SingleLoomsTotal"
Riga = 12
check = False
Ncartelle = 0

While Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) <> ""
    If Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) Like ("*" & "IS" & "*") _
      Or Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) Like ("*" & "IT" & "*") Then     'La ricerca sarà Case Sensitive
         Cells(Riga, 8).Interior.ColorIndex = 6
           Cartella = "C:\Users\Admin\Documents\perClemente\" & Cells(Riga - 1, 9)
          If Not FileSystemObj.folderExists(Cartella) Then
             FileSystemObj.CreateFolder Cartella
             Ncartelle = Ncartelle + 1
          End If
             pbase = "C:\Users\Admin\Documents\perClemente\Installativi\"               '***
             FileSystemObj.CopyFile pbase & "*" & Cells(Riga, 2) & "*", Cartella   '***
          Riga = Riga + 1
          check = True
      Else
        Riga = Riga + 1
    End If
    If Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 1) <> "" _
        And Workbooks("pergiuseppe1.xls").Worksheets("SingleLoomsTotal").Cells(Riga, 8) = "" Then
          Riga = Riga + 11
    End If
Wend
If check Then
       Cartella = "C:\Users\Admin\Documents\perClemente\" & Cells(Riga - 1, 9)
       If Not FileSystemObj.folderExists(Cartella) Then
          FileSystemObj.CreateFolder Cartella
          Ncartelle = Ncartelle + 1
       End If
       pbase = "C:\Users\Admin\Documents\perClemente\Installativi\"               '***
       FileSystemObj.CopyFile pbase & "*" & Cells(Riga - 1, 2) & "*", Cartella   '***
End If
MsgBox " Sono state create " & Ncartelle & " cartelle in C:\Users\Admin\Documents\perClemente"
End Sub


volevo allegare anche l'immagine di come era fatto più o meno il file Excel, ma non sono riuscito...pazienza

Grazie
giubar
giubar
Newbie
 
Post: 8
Iscritto il: 18/09/16 18:53


Torna a Applicazioni Office Windows


Topic correlati a "Cercare files in una directory copiarli ed incollarli":


Chi c’è in linea

Visitano il forum: Nessuno e 5 ospiti