Allora ho voluto proporti una cosa piu’ complessa di come la chiedevi perche’... non si sa mai.
Parti da un nuovo file Excel, con tre fogli: Foglio1, Foglio2, Foglio3
Su Foglio1 crea la descrizione delle modifiche da apportare ai file, come da figura:
In pratica devi indicare quale foglio, quale range, il nuovo valore
Ogni riga descrive una modifica, e puoi creare quante righe vuoi.
Foglio2 lo riserviamo per creare l’elenco dei file da modificare; in proposito ho ipotizzato che i file da modificare siano in una specifica cartella ed eventuali sottocartelle.
Foglio3 lo riserviamo per creare un “log” delle modifiche apportate; in particolare per ogni modifica scriveremo:
-il percorso del file
-il nome del file, il foglio, il range, il vecchio valore in quel range, il valore nuovo assegnato
Teoricamente questo dovrebbe aiutarti a recuperare (senza il mio aiuto) eventuali casini fatti.
Inserisci in questo file un Modulo standard del vba e copiavi il seguente codice:
- Codice: Seleziona tutto
Dim myFso As Object, ccAll As Long 'RIGOROSAMENTE IN TESTA AL MODULO
Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm, mySplit, myInd
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
On Error GoTo Mahh
For Each myItm In myFso.GetFolder(ccDir).Files
ccAll = ccAll + 1
mySplit = Split(" " & myItm, ".", , vbTextCompare)
If Not IsError(Application.Match(mySplit(UBound(mySplit)), myExt, 0)) Then
myInd = UBound(cStore)
ReDim Preserve cStore(1 To myInd + 1)
cStore(myInd) = myItm
End If
Mahh:
Resume Bohh
Bohh:
Next myItm
For Each myItm In myFso.GetFolder(ccDir).SubFolders
Call RecurDir(myItm, myExt, cStore)
Next myItm
End Function
Sub MakeList()
Dim strFile As String, ShIndex As Worksheet
'' Dim stdPic As StdPicture
'' Dim lngWidth As Long
'' Dim lngHeight As Long
Dim strPath As String, mySplit
Dim intRow As Long, AllPics, StrDir As String, I As Long
'
Sheets("Foglio2").Select
Dim FArr() As String
ReDim FArr(1 To 1)
AllPics = Array("xls", "xlsx", "xlsm", "xlsb") '<<< Altri formati? '***
StrDir = "C:\PROVA\NUOVA" '<<< Il Percorso iniziale
Call RecurDir(StrDir, AllPics, FArr)
Range("A2").Resize(UBound(FArr), 1).Value = Application.WorksheetFunction.Transpose(FArr)
On Error Resume Next
Set myFso = Nothing
On Error GoTo 0
MsgBox ("Indice creato, " & UBound(FArr))
Debug.Print "Indice creato, " & UBound(FArr)
End Sub
Sub GodSaveTony()
Dim ShIndex As Worksheet, ModSh As Worksheet, LogSh As Worksheet
Dim lIndex As Long, I As Long, J As Long
Set ShIndex = ThisWorkbook.Sheets("Foglio2")
Set ModSh = ThisWorkbook.Sheets("Foglio1")
Set LogSh = ThisWorkbook.Sheets("Foglio3")
ShIndex.Select
Application.EnableEvents = False
For I = 1 To ShIndex.Cells(Rows.Count, 1).End(xlUp).Row
If ShIndex.Cells(I, 1) <> "" Then
lIndex = LogSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks.Open ShIndex.Cells(I, 1).Value
LogSh.Cells(lIndex, 1) = ShIndex.Cells(I, 1).Value
LogSh.Cells(lIndex, 2) = ActiveWorkbook.Name
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
For J = 2 To ModSh.Cells(Rows.Count, 1).End(xlUp).Row
If LogSh.Cells(lIndex, 1) = "" Then LogSh.Cells(lIndex, 1) = Chr(34)
LogSh.Cells(lIndex, 3) = ModSh.Cells(J, 1)
LogSh.Cells(lIndex, 4) = ModSh.Cells(J, 2)
LogSh.Cells(lIndex, 5) = Sheets(ModSh.Cells(J, 1).Value).Range(ModSh.Cells(J, 2).Value).Value
LogSh.Cells(lIndex, 6) = ModSh.Cells(J, 3)
Sheets(ModSh.Cells(J, 1).Value).Range(ModSh.Cells(J, 2).Value).Value = ModSh.Cells(J, 3)
lIndex = lIndex + 1
Next J
End If
ShIndex.Cells(I, 2).Value = ShIndex.Cells(I, 1).Value
ShIndex.Cells(I, 1).ClearContents
Exit For
End If
Next I
Application.EnableEvents = True
Beep
End Sub
Il codice include:
-una funzione (Function RecurDir) in grado di ispezionare Cartelle e sottocartelle
-una Sub MakeList, che crea su Foglio2 l’elenco dei file presenti nella Cartella di partenza e le sue sottocartelle; la cartella di partenza va scritta in una delle due istruzioni marcate <<<
-una Sub GodSaveTony, che e’ quella che legge l’elenco dei file creati su Foglio2, apre il primo della lista, vi applica le modifiche descritte su Foglio1 e scrive “il diario” su Foglio3
Dopo che hai preparato il file con il codice, salvalo per prudenza. Poi avvia la Sub MakeList.
Controlla che l’elenco su Foglio2 sia verosimile (meglio se controlli che sia anche veritiero)
Quando sei pronto lancia la Sub GodSaveTony; come detto il primo file sara’ aperto e vi saranno applicate le modifiche; la macro termina lasciando questo file aperto, tocca a te controllare e chiudere.
Rilanciando la Sub GodSaveTony lo stesso lavoro sara’ fatto sul secondo file, e cosi’ via fintanto che l’elenco di Colonna A di Foglio2 non sara’ vuoto (infatti man mano che i file vengono lavorati il suo nome si sposta su colonna B).
Ovviamente puoi interrompere il lavoro e riprenderlo dopo una pausa ristoratrice di 1 minuto (ma funziona anche con una pausa di una notte)
Questo e’ quanto... Mi raccomando, fai le prove su un elenco di file di prova...
Registrazione
