Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
VBA: estrarre le sottocartelle contenute in una determinata cartella e rinominarle
1,190 views
Skip to first unread message
draleo
Feb 13, 2016, 2:15:28 PM2/13/16
to
Data la cartella C:\Disney;
all'interno di essa vi sono numerose altre sottocartelle (es:paperino,qui,quo,qua ecc)
Dovrei fare 2 cose:
1)Mettere in un Foglio excel (nella colonna A ,da A2 in giù, i nomi di tali sottocartelle (SENZA i nomi dei files al loro interno contenute)
2) rinominare tale sottocartelle con nuovi nomi ,che poi indicherò nella colonna B
Ho cercato nel gruppo , ma ho trovato solo procedure che mi estraggono tutti i files delle cartelle presenti e , per la mia ignoranza, non sono riuscito ad adattarli alla mia esigenza.
Poi una volta rinominate le cartelle , dovrò rinominare anche i files in esse contenute. Ma questo è un problema che proverò ad affrontare successivamente
Mi aiutate ?
grazie
draleo
all'interno di essa vi sono numerose altre sottocartelle (es:paperino,qui,quo,qua ecc)
Dovrei fare 2 cose:
1)Mettere in un Foglio excel (nella colonna A ,da A2 in giù, i nomi di tali sottocartelle (SENZA i nomi dei files al loro interno contenute)
2) rinominare tale sottocartelle con nuovi nomi ,che poi indicherò nella colonna B
Ho cercato nel gruppo , ma ho trovato solo procedure che mi estraggono tutti i files delle cartelle presenti e , per la mia ignoranza, non sono riuscito ad adattarli alla mia esigenza.
Poi una volta rinominate le cartelle , dovrò rinominare anche i files in esse contenute. Ma questo è un problema che proverò ad affrontare successivamente
Mi aiutate ?
grazie
draleo
casanmaner
Feb 13, 2016, 4:01:47 PM2/13/16
to
Prova con queste procedure (da copiare in un modulo standard).
'-------------
Option Explicit
Public Const strPath = "C:\Users\Utente\Desktop\Path" '<- impostare percorso principale
Sub ElencaPath()
Dim fso, Path, subPaths, pth
Dim FirstRng As Range
Dim i As Long
Set FirstRng = ThisWorkbook.Worksheets("Foglio1").Range("A2") '<--- impostare foglio e cella di partenza
Set fso = CreateObject("Scripting.FileSystemObject")
Set Path = fso.GetFolder(strPath)
Set subPaths = Path.SubFolders
i = 0
For Each pth In subPaths
FirstRng.Offset(i).Value = fso.GetBaseName(pth)
i = i + 1
Next pth
End Sub
Sub RinominaPath()
Dim FirstRng As Range
Dim i As Long
Set FirstRng = ThisWorkbook.Worksheets("Foglio1").Range("A2") '<--- impostare foglio e cella di partenza
i = 0
Do While FirstRng.Offset(i) <> ""
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value
i = i + 1
Loop
End Sub
'-------------
Io ho testato ma, ovviamente, fai una copia delle delle cartelle prima di provare le procedure ... sai com'è ;-)
draleo
Feb 14, 2016, 4:31:34 AM2/14/16
to
Ok. Funziona. Ma ha 2 problemi:
1)non estrae le subcartelle compresse o zippate
2)all'inizio di ogni operazione tutti i dati presenti sul foglio dovrebbero essere cancellati altrimenti alla seconda operazione si mischiano con quelli della prima e non si capisce più niente
grazie
draleo
1)non estrae le subcartelle compresse o zippate
2)all'inizio di ogni operazione tutti i dati presenti sul foglio dovrebbero essere cancellati altrimenti alla seconda operazione si mischiano con quelli della prima e non si capisce più niente
grazie
draleo
casanmaner
Feb 14, 2016, 5:12:33 AM2/14/16
to
Sul punto 1) non so se sia possibile (bisognerebbe studiare più a fondo i metodi e proprietà del FileSystemObject.
Prova a dare un'occhiata qui:
(in italiano)
https://msdn.microsoft.com/it-it/library/aa711216%28v=vs.71%29.aspx
o in inglese (più completo)
https://msdn.microsoft.com/en-us/library/6tkce7xa%28v=vs.84%29.aspx
Per il punto due sarebbe opportuno sapere se in A1 e B1 hai inserito del testo (ad es. delle "etichette") o se sono celle vuote.
Prova a dare un'occhiata qui:
(in italiano)
https://msdn.microsoft.com/it-it/library/aa711216%28v=vs.71%29.aspx
o in inglese (più completo)
https://msdn.microsoft.com/en-us/library/6tkce7xa%28v=vs.84%29.aspx
Per il punto due sarebbe opportuno sapere se in A1 e B1 hai inserito del testo (ad es. delle "etichette") o se sono celle vuote.
draleo
Feb 14, 2016, 5:41:39 AM2/14/16
to
per il punto 2 ho risolto aggiungendo la sub
Sub cancelladati()
With ActiveSheet
Range(Range("A2"), .UsedRange.SpecialCells(xlLastCell)).Clear
End With
End Sub
per il punto 1 leggerò il link sperando di capirci qualcosa
Inoltre facendo alcune prove mi sono accorto che cambiare ogni volta il path sul codice può essere scomodo
Non si potrebbe rendere il path variabile e collegarlo ad una cella del foglio1, per es D1 ? in tal modo scrivendolo in una cella potrebbe essere più comodo
draleo
Sub cancelladati()
With ActiveSheet
Range(Range("A2"), .UsedRange.SpecialCells(xlLastCell)).Clear
End With
End Sub
per il punto 1 leggerò il link sperando di capirci qualcosa
Inoltre facendo alcune prove mi sono accorto che cambiare ogni volta il path sul codice può essere scomodo
Non si potrebbe rendere il path variabile e collegarlo ad una cella del foglio1, per es D1 ? in tal modo scrivendolo in una cella potrebbe essere più comodo
draleo
casanmaner
Feb 14, 2016, 7:54:25 AM2/14/16
to
Se A1 e B1 sono celle vuote puoi anche semplicemente scrivere
Range("A2").CurrentRegion.Clear
Per il percorso certamente puoi indicarlo in una cella e poi fare riferimento a quella invece che alla variabile strPath. O, in alternativa, non impostare come Const la suddetta variabile ma impostarla in base al valore delle cella.
Ad es. scrivendo in A1 il percorso e inserendo i nomi delle sotto cartelle da A3 (per lasciare una riga di spazio ed utilizzare UsedRange potresti utilizzare queste macro:
Option Explicit
Public strPath As String
Sub ElencaPath()
Dim fso, Path, subPaths, pth
Dim FirstRng As Range
Dim i As Long
With ThisWorkbook
With .Worksheets("Foglio1") '<--- impostare foglio
strPath = .Range("A1") '<--- impostare cella in cui è indicato il percorso principale
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set Path = fso.GetFolder(strPath)
Set subPaths = Path.SubFolders
i = 0
For Each pth In subPaths
FirstRng.Offset(i).Value = fso.GetBaseName(pth)
i = i + 1
Next pth
End Sub
Sub RinominaPath()
Dim FirstRng As Range
Dim i As Long
With ThisWorkbook
With .Worksheets("Foglio1") '<--- impostare foglio
strPath = .Range("A1") '<--- impostare cella in cui è indicato il percorso principale
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
Dim FirstRng As Range
With ThisWorkbook
With .Worksheets("Foglio1") '<--- impostare foglio
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
FirstRng.CurrentRegion.ClearContents
End Sub
Range("A2").CurrentRegion.Clear
Per il percorso certamente puoi indicarlo in una cella e poi fare riferimento a quella invece che alla variabile strPath. O, in alternativa, non impostare come Const la suddetta variabile ma impostarla in base al valore delle cella.
Ad es. scrivendo in A1 il percorso e inserendo i nomi delle sotto cartelle da A3 (per lasciare una riga di spazio ed utilizzare UsedRange potresti utilizzare queste macro:
Option Explicit
Public strPath As String
Sub ElencaPath()
Dim fso, Path, subPaths, pth
Dim FirstRng As Range
Dim i As Long
With .Worksheets("Foglio1") '<--- impostare foglio
strPath = .Range("A1") '<--- impostare cella in cui è indicato il percorso principale
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set Path = fso.GetFolder(strPath)
Set subPaths = Path.SubFolders
i = 0
For Each pth In subPaths
FirstRng.Offset(i).Value = fso.GetBaseName(pth)
i = i + 1
Next pth
End Sub
Sub RinominaPath()
Dim FirstRng As Range
Dim i As Long
With .Worksheets("Foglio1") '<--- impostare foglio
strPath = .Range("A1") '<--- impostare cella in cui è indicato il percorso principale
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
i = 0
Do While FirstRng.Offset(i) <> ""
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value
i = i + 1
Loop
End Sub
Sub CancellaDati()
Do While FirstRng.Offset(i) <> ""
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value
i = i + 1
Loop
End Sub
Dim FirstRng As Range
With ThisWorkbook
With .Worksheets("Foglio1") '<--- impostare foglio
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
FirstRng.CurrentRegion.ClearContents
End Sub
draleo
Feb 14, 2016, 11:47:19 AM2/14/16
to
OK. Va molto bene. Grazie
draleo
draleo
Norman Jones
Feb 14, 2016, 4:55:06 PM2/14/16
to
Ciao Draleo,
Per un altro approcchio alla scelta del percorso, prova il seguente
codice che rappresenta una leggera modifica dell'ottimo suggerimento di
Casanmaner:
'=========>>
Option Explicit
'--------->>
Public Sub ElencaPath()
Dim WB As Workbook
Dim SH As Worksheet
Dim fso As Object, subPaths As Object, pth As Object
Dim ShellApp As Object
Dim sPath As String
Dim FirstRng As Range, dataRng As Range
Dim i As Long
Dim bProblem As Boolean
Set WB = ThisWorkbook
Set SH = WB.Sheets("Foglio1")
With SH
End With
dataRng.ClearContents
bProblem = False
Set ShellApp = CreateObject("Shell.Application"). _
Browseforfolder(0, "SELEZIONA UNA FOLDER", 0, "c:\\")
On Error Resume Next
sPath = ShellApp.self.Path
Set subPaths = fso.GetFolder(sPath).SubFolders
If Err.Number <> 0 Then
If MsgBox(Prompt:="Non hai scelto una folder valida!" _
& vbNewLine & vbNewLine & _
"Vuoi riprovare?", _
Buttons:=vbYesNoCancel, _
Title:="CARTELLA NECESSARIA!") <> vbYes Then
Exit Sub
End If
bProblem = True
End If
On Error GoTo 0
Loop Until bProblem = False
i = 0
For Each pth In subPaths
With FirstRng.Offset(i)
.NumberFormat = "@"
.Value = CStr(fso.GetBaseName(pth))
End With
.Cells(0).Value = "SottoCartelle di :" & sPath
.EntireColumn.AutoFit
End With
End Sub
'<<=========
===
Regards,
Norman
Per un altro approcchio alla scelta del percorso, prova il seguente
codice che rappresenta una leggera modifica dell'ottimo suggerimento di
Casanmaner:
'=========>>
Option Explicit
'--------->>
Public Sub ElencaPath()
Dim WB As Workbook
Dim SH As Worksheet
Dim fso As Object, subPaths As Object, pth As Object
Dim ShellApp As Object
Dim sPath As String
Dim FirstRng As Range, dataRng As Range
Dim i As Long
Dim bProblem As Boolean
Set WB = ThisWorkbook
Set SH = WB.Sheets("Foglio1")
With SH
Set FirstRng = .Range("A3")
Set dataRng = .Range(FirstRng(0), FirstRng.End(xlDown))
End With
dataRng.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Do
bProblem = False
Set ShellApp = CreateObject("Shell.Application"). _
Browseforfolder(0, "SELEZIONA UNA FOLDER", 0, "c:\\")
On Error Resume Next
sPath = ShellApp.self.Path
Set subPaths = fso.GetFolder(sPath).SubFolders
If Err.Number <> 0 Then
If MsgBox(Prompt:="Non hai scelto una folder valida!" _
& vbNewLine & vbNewLine & _
"Vuoi riprovare?", _
Buttons:=vbYesNoCancel, _
Title:="CARTELLA NECESSARIA!") <> vbYes Then
Exit Sub
End If
bProblem = True
End If
On Error GoTo 0
Loop Until bProblem = False
i = 0
For Each pth In subPaths
.NumberFormat = "@"
.Value = CStr(fso.GetBaseName(pth))
End With
i = i + 1
Next pth
With FirstRng
Next pth
.Cells(0).Value = "SottoCartelle di :" & sPath
.EntireColumn.AutoFit
End With
End Sub
'<<=========
===
Regards,
Norman
Vittorio
Feb 14, 2016, 5:25:00 PM2/14/16
to
<Ok. Funziona. Ma ha 2 problemi:
<1)non estrae le subcartelle compresse o zippate
ovvio,le cartelle zippate sono file!
<1)non estrae le subcartelle compresse o zippate
Questa sub trova cartelle zippate con estensione zip distinguendole dai
semplici file zippati (in quanto le prime al loro interno contengono la
cartella, i secondi no) .
Sub testcartella()
Set oApp = CreateObject("Shell.Application")
Set objFolder = oApp.Namespace("C:\test")
For Each ff In oApp.Namespace(objFolder).items
If oApp.Namespace(objFolder).getdetailsof(ff, 2) = "Cartella di file"
Then
MsgBox (oApp.Namespace(objFolder).getdetailsof(ff, 0) & " è una
cartella normale")
Else: MsgBox (oApp.Namespace(objFolder).getdetailsof(ff, 0) & " non è
una cartella normale")
s = oApp.Namespace(objFolder).getdetailsof(ff, 0)
If (Right(s, Len(s) - InStrRev(s, ".")) = "zip") Then
Set objFolderItem = objFolder.ParseName(ff)
For Each f In oApp.Namespace(objFolderItem).items
If oApp.Namespace(objFolderItem).getdetailsof(f, 1) = "Cartella
di file" Then
MsgBox ("è una cartella zippata")
Else: MsgBox ("è un file ")
End If
Next f
End If
End If
Next ff
End Sub
Norman Jones
Feb 14, 2016, 6:55:30 PM2/14/16
to
Vedo che il mio codice è stato riformato e addirtura modificato. Quindi,
riprovo!
riprovo!
Bruno Campanini
Feb 14, 2016, 8:10:52 PM2/14/16
to
draleo explained on 13-02-16 :
Ed io fui quarto fra cotanto senno.
=======================================
Public Sub GetFolders()
Dim FSO As New FileSystemObject, StartCell As Range, j As Long
Set StartCell = [Sheet2!A1]
Range(StartCell(2), StartCell(2).End(xlDown)).ClearContents
For Each i In FSO.GetFolder(StartCell).SubFolders
j = j + 1
StartCell(j + 1) = FSO.GetBaseName(i)
Next
End Sub
=======================================
--- Intermission ---
=======================================
Public Sub RenameFolders()
Dim SourceRange As Range, i
Set SourceRange = [Sheet2!A1].Offset(1)
For Each i In Range(SourceRange, SourceRange.End(xlDown))
i.Value = i(1, 2)
Next
End Sub
========================================
Bruno
=======================================
Public Sub GetFolders()
Dim FSO As New FileSystemObject, StartCell As Range, j As Long
Set StartCell = [Sheet2!A1]
Range(StartCell(2), StartCell(2).End(xlDown)).ClearContents
For Each i In FSO.GetFolder(StartCell).SubFolders
j = j + 1
StartCell(j + 1) = FSO.GetBaseName(i)
Next
End Sub
=======================================
--- Intermission ---
=======================================
Public Sub RenameFolders()
Dim SourceRange As Range, i
Set SourceRange = [Sheet2!A1].Offset(1)
For Each i In Range(SourceRange, SourceRange.End(xlDown))
i.Value = i(1, 2)
Next
End Sub
========================================
Bruno
Bruno Campanini
Feb 14, 2016, 8:15:50 PM2/14/16
to
Bruno Campanini used his keyboard to write :
Errata
Public Sub GetFolders()
Dim FSO As New FileSystemObject, StartCell As Range, j As Long, i
Bruno
Errata
> Public Sub GetFolders()
> Dim FSO As New FileSystemObject, StartCell As Range, j As Long
Corrige
> Dim FSO As New FileSystemObject, StartCell As Range, j As Long
Public Sub GetFolders()
Dim FSO As New FileSystemObject, StartCell As Range, j As Long, i
Bruno
Norman Jones
Feb 14, 2016, 10:05:46 PM2/14/16
to
Ciao Bruno,
On 15/02/2016 01:10, Bruno Campanini wrote, inter alia:
> Public Sub GetFolders()
> Dim FSO As New FileSystemObject
Questo uso del cosiddetto 'early binding' richiede che ci sia stato
aggiunto un riferimento alla libreria Microsoft Scripting Runtime.
Vorrei aggiungere, en passant, che credo sia consigliable evitare questo
modo di dichiare l'oggetto FSO.
Vorrei suggerire che sia preferibile utilizzare un construtto del genere:
Dim FSO As FileSystemObject
Set FSO New Scripting.FileSystemObject
Al questo riguardo vedi i commenti in materia di Chip Pearson a:
http://www.cpearson.com/Excel/DeclaringVariables.aspx
Più in particolare vedi la seguente sezione:
----------->>
Don't Use Auto-Instancing Object Variables
=========================================
For object type variables, it is possible to include the New keyword in
the Dim statement. Doing so create what is called an auto-instancing
variable. Again, while this may seem convenient, it should be avoided.
Contrary to what some programmers may believe, the object isn't created
when the variable declaration is processed. Instead, the object is
created when it is first encountered in the code. This means that,
first, you have limited control when an object is created. Second, it
means that you cannot test whether an object is Nothing, a common test
within code and a common testing and diagnostic technique. If the
compiler's output were in VBA code, the code to handle auto-instancing
variables would look like the following:
Dim FSO As New Scripting.FileSystemObject
'''''''''''
' more code
'''''''''''
If FSO Is Nothing Then ' The compiler does something like this
Set FSO = New Scripting.FileSystemObject
End If
Here, simply testing FSO for Nothing causes the object to be created and
therefore FSO will never test properly for the Nothing state. Instead of
using New in the variable's declaration, use the Set New syntax:
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
'<<-----------
Tornando alla tua seconda routine:
>> Poi una volta rinominate le cartelle , dovrò rinominare anche i
>> files in esse contenute.
===
Regards,
Norman
On 15/02/2016 01:10, Bruno Campanini wrote, inter alia:
> Public Sub GetFolders()
> Dim FSO As New FileSystemObject
aggiunto un riferimento alla libreria Microsoft Scripting Runtime.
Vorrei aggiungere, en passant, che credo sia consigliable evitare questo
modo di dichiare l'oggetto FSO.
Vorrei suggerire che sia preferibile utilizzare un construtto del genere:
Dim FSO As FileSystemObject
Set FSO New Scripting.FileSystemObject
Al questo riguardo vedi i commenti in materia di Chip Pearson a:
http://www.cpearson.com/Excel/DeclaringVariables.aspx
Più in particolare vedi la seguente sezione:
----------->>
Don't Use Auto-Instancing Object Variables
=========================================
For object type variables, it is possible to include the New keyword in
the Dim statement. Doing so create what is called an auto-instancing
variable. Again, while this may seem convenient, it should be avoided.
Contrary to what some programmers may believe, the object isn't created
when the variable declaration is processed. Instead, the object is
created when it is first encountered in the code. This means that,
first, you have limited control when an object is created. Second, it
means that you cannot test whether an object is Nothing, a common test
within code and a common testing and diagnostic technique. If the
compiler's output were in VBA code, the code to handle auto-instancing
variables would look like the following:
Dim FSO As New Scripting.FileSystemObject
'''''''''''
' more code
'''''''''''
If FSO Is Nothing Then ' The compiler does something like this
Set FSO = New Scripting.FileSystemObject
End If
Here, simply testing FSO for Nothing causes the object to be created and
therefore FSO will never test properly for the Nothing state. Instead of
using New in the variable's declaration, use the Set New syntax:
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
'<<-----------
Tornando alla tua seconda routine:
> =======================================
> Public Sub RenameFolders()
> Dim SourceRange As Range, i
> Set SourceRange = [Sheet2!A1].Offset(1)
> For Each i In Range(SourceRange, SourceRange.End(xlDown))
> i.Value = i(1, 2)
> Next
> End Sub
> ========================================
non credo che rinomini i file come indicato da Draleo:
> Public Sub RenameFolders()
> Dim SourceRange As Range, i
> Set SourceRange = [Sheet2!A1].Offset(1)
> For Each i In Range(SourceRange, SourceRange.End(xlDown))
> i.Value = i(1, 2)
> Next
> End Sub
> ========================================
>> Poi una volta rinominate le cartelle , dovrò rinominare anche i
>> files in esse contenute.
Regards,
Norman
Norman Jones
Feb 14, 2016, 10:19:46 PM2/14/16
to
On 15/02/2016 03:05, Norman Jones wrote:
> non credo che rinomini i file come indicato da Draleo:
Questo avrebbe dovuto essere:
> non credo che rinomini i file come indicato da Draleo:
non credo che rinomini le cartelle come indicato da Draleo:
===
Regards,
Norman
Bruno Campanini
Feb 15, 2016, 6:42:04 AM2/15/16
to
Norman Jones explained :
> Ciao Bruno,
>
> On 15/02/2016 01:10, Bruno Campanini wrote, inter alia:
>
>> Public Sub GetFolders()
>> Dim FSO As New FileSystemObject
>
> Questo uso del cosiddetto 'early binding' richiede che ci sia stato aggiunto
> un riferimento alla libreria Microsoft Scripting Runtime.
Ovviamente
> Vorrei aggiungere, en passant, che credo sia consigliable evitare questo modo
> di dichiare l'oggetto FSO.
[...]
Se non hai la necessità - che qui è proprio esclusa - di testare
l'esistenza dell'oggetto prima di eventualmente (ri)crearlo, non
hai certamente problemi col crearlo con Dim FSO as New...
Beh, e su:
Set StartCell = [Sheet2!A1]
non hai niente da dire? o ti sei convertito?
Ciao
Bruno
> Ciao Bruno,
>
> On 15/02/2016 01:10, Bruno Campanini wrote, inter alia:
>
>> Public Sub GetFolders()
>> Dim FSO As New FileSystemObject
>
> Questo uso del cosiddetto 'early binding' richiede che ci sia stato aggiunto
> un riferimento alla libreria Microsoft Scripting Runtime.
> Vorrei aggiungere, en passant, che credo sia consigliable evitare questo modo
> di dichiare l'oggetto FSO.
Se non hai la necessità - che qui è proprio esclusa - di testare
l'esistenza dell'oggetto prima di eventualmente (ri)crearlo, non
hai certamente problemi col crearlo con Dim FSO as New...
Beh, e su:
Set StartCell = [Sheet2!A1]
non hai niente da dire? o ti sei convertito?
Ciao
Bruno
Norman Jones
Feb 15, 2016, 6:59:21 AM2/15/16
to
Ciao Bruno,
> Beh, e su:
> Set StartCell = [Sheet2!A1]
> non hai niente da dire? o ti sei convertito?
>
Mai! E ancora mai!!
Tuttavia, ne abbiamo parlato in grande dettaglio anni fa e, a parte del
fatto che credo che tu sappia il mio parere in materia molto bene, non
vedevo l'utilità, di rimasticare quelli argomenti in questo thread.
Comunque, sia paziente, tra poco sono sicuro che ritorneremo alla scena
di quei vecchi battaglie! :-)
===
Regards,
Norman
> Beh, e su:
> Set StartCell = [Sheet2!A1]
> non hai niente da dire? o ti sei convertito?
>
Tuttavia, ne abbiamo parlato in grande dettaglio anni fa e, a parte del
fatto che credo che tu sappia il mio parere in materia molto bene, non
vedevo l'utilità, di rimasticare quelli argomenti in questo thread.
Comunque, sia paziente, tra poco sono sicuro che ritorneremo alla scena
di quei vecchi battaglie! :-)
===
Regards,
Norman
Norman Jones
Feb 15, 2016, 7:04:55 AM2/15/16
to
On 15/02/2016 11:59, Norman Jones wrote:
> quei vecchi battaglie!
Avrebbe dovuto essere:
quelle vecchie
===
Regards,
Norman
> quei vecchi battaglie!
Avrebbe dovuto essere:
quelle vecchie
===
Regards,
Norman
Bruno Campanini
Feb 15, 2016, 9:25:43 AM2/15/16
to
Norman Jones used his keyboard to write :
Non voglio tornare alle vecchie battaglie anche se è
sempre piacevole ascoltare autorevoli pareri opposti.
Pareri che condivido nella logica che li manifesta
ma che reputo - vexata quaestio - ininfluenti nelle
pratiche applicazioni in relazione alle quali li
abbiamo trattati.
Voglio dire che il mio pragmatismo si fermerebbe davanti
all'evidenza di effetti pratici.
Il tuo formalismo invece non è tenuto, giustamente,
a conoscere limiti.
Alla prossima Norton.
Bruno
Alla prossima Norman.
Bruno
sempre piacevole ascoltare autorevoli pareri opposti.
Pareri che condivido nella logica che li manifesta
ma che reputo - vexata quaestio - ininfluenti nelle
pratiche applicazioni in relazione alle quali li
abbiamo trattati.
Voglio dire che il mio pragmatismo si fermerebbe davanti
all'evidenza di effetti pratici.
Il tuo formalismo invece non è tenuto, giustamente,
a conoscere limiti.
Alla prossima Norton.
Bruno
Alla prossima Norman.
Bruno
casanmaner
Feb 15, 2016, 10:50:55 AM2/15/16
to
Ciao Norman,
alla tua io proporrei una modifica per fare in modo che il percorso sia inserito in una cella in maniera autonoma così draleo non sarà costretto a scrivere, nella procedura di rinomina delle cartelle, del codice per estrarre la stringa di testo contenente il percorso principale.
Quindi proporrei, visto che abbiamo una prima cella disponibile posto che si parte da A3 per inserire i nomi delle sottocartelle, questa modifica alla parte finale della tua procedura:
'....
With FirstRng
.Cells(-1).value= "SottoCartelle di:"
.Cells(0).Value = sPath
.EntireColumn.AutoFit
End With
'....
alla tua io proporrei una modifica per fare in modo che il percorso sia inserito in una cella in maniera autonoma così draleo non sarà costretto a scrivere, nella procedura di rinomina delle cartelle, del codice per estrarre la stringa di testo contenente il percorso principale.
Quindi proporrei, visto che abbiamo una prima cella disponibile posto che si parte da A3 per inserire i nomi delle sottocartelle, questa modifica alla parte finale della tua procedura:
'....
With FirstRng
.Cells(-1).value= "SottoCartelle di:"
.Cells(0).Value = sPath
.EntireColumn.AutoFit
End With
'....
draleo
Feb 15, 2016, 10:58:39 AM2/15/16
to
Allora
-La versione di Casanmer funziona molto bene (estrae i nomi delle subfolder e le rinomina)
-la versione di Vittorio -sub testcartella()-mi da errore di sintassi (endif senza blocco if). Non mi sembra di aver sbagliato nel copiarla, ma non si sa mai
-la prima versione di Norman estrae molto bene le subfolders , ma manca la parte che dovrebbe rinominarle.
-la seconda versione di norman -qualsiasi cartella indichi- mi dice che non è una cartella valida
-Anche la versione di Bruno estrae molto bene le subfolders nel foglio2 da A2 in giù; ma la sub che dovrebbe rinominarle, non da nessun risultato (nel senso che non le rinomina).Io ho messo i nomi da usare per rinominarle nello stesso foglio da B2 in giù. Ho sbagliato ?
grazie a tutti
-La versione di Casanmer funziona molto bene (estrae i nomi delle subfolder e le rinomina)
-la versione di Vittorio -sub testcartella()-mi da errore di sintassi (endif senza blocco if). Non mi sembra di aver sbagliato nel copiarla, ma non si sa mai
-la prima versione di Norman estrae molto bene le subfolders , ma manca la parte che dovrebbe rinominarle.
-la seconda versione di norman -qualsiasi cartella indichi- mi dice che non è una cartella valida
-Anche la versione di Bruno estrae molto bene le subfolders nel foglio2 da A2 in giù; ma la sub che dovrebbe rinominarle, non da nessun risultato (nel senso che non le rinomina).Io ho messo i nomi da usare per rinominarle nello stesso foglio da B2 in giù. Ho sbagliato ?
grazie a tutti
casanmaner
Feb 15, 2016, 11:15:10 AM2/15/16
to
La seconda di Norman a me riporta correttamente le subfolder a patto di selezionare una cartella (e non ad es. la "Raccolta").
Quella di Bruno in effetti non rinomina le subfolder. Legge il valore della cella accanto a quella dove è presente il nome originario della subfolder ma manca il comandi di rinomina. Gli sarà rimasto un po' di codice nella tastiera :-)
Bruno Campanini
Feb 15, 2016, 12:11:05 PM2/15/16
to
casanmaner explained on 15-02-16 :
[...]
Molto velocemente e altrettanto stupidamente ho rinominato
la colonna di Excel contenente le directory anziché
le directory medesime...
==========================
Public Sub RenameFolders()
Dim SourceRange As Range, i
Set SourceRange = [Sheet2!A1].Offset(1)
For Each i In Range(SourceRange, SourceRange.End(xlDown))
Name [A1] & "\" & i As [A1] & "\" & i(1, 2)
Next
End Sub
========================
Bruno
[...]
> Quella di Bruno in effetti non
> rinomina le subfolder. Legge il valore della cella accanto a quella dove è
> presente il nome originario della subfolder ma manca il comandi di rinomina.
> Gli sarà rimasto un po' di codice nella tastiera :-)
Troppo buono!
> rinomina le subfolder. Legge il valore della cella accanto a quella dove è
> presente il nome originario della subfolder ma manca il comandi di rinomina.
> Gli sarà rimasto un po' di codice nella tastiera :-)
Molto velocemente e altrettanto stupidamente ho rinominato
la colonna di Excel contenente le directory anziché
le directory medesime...
==========================
Public Sub RenameFolders()
Dim SourceRange As Range, i
Set SourceRange = [Sheet2!A1].Offset(1)
For Each i In Range(SourceRange, SourceRange.End(xlDown))
Next
End Sub
========================
Bruno
Norman Jones
Feb 15, 2016, 12:49:59 PM2/15/16
to
Ciao Draleo,
Dato che hai una soluzione funzionante, rispondo ora solo per la
completezza.
> -la prima versione di Norman estrae molto bene le subfolders ,
> ma manca la parte che dovrebbe rinominarle.
Avendo visto l'ottimo suggerimento di Casanmaner, mi sono limitato ad
affrontarte un solo aspetto del problema. QQuest ho tentato di indicare
cosi:
'--------->>
> -la seconda versione di norman -qualsiasi cartella indichi-
> mi dice che non è una cartella valida
A me funziona senza alcun problema ma vedi i commenenti in merito di
Casanmaner nella sua ultima risposta qui sotto.
===
Regards,
Norman
Dato che hai una soluzione funzionante, rispondo ora solo per la
completezza.
> -la prima versione di Norman estrae molto bene le subfolders ,
> ma manca la parte che dovrebbe rinominarle.
affrontarte un solo aspetto del problema. QQuest ho tentato di indicare
cosi:
'--------->>
Per un altro approcchio alla scelta del percorso, prova il seguente
codice che rappresenta una leggera modifica dell'ottimo suggerimento di
Casanmaner:
'<<---------
codice che rappresenta una leggera modifica dell'ottimo suggerimento di
Casanmaner:
> -la seconda versione di norman -qualsiasi cartella indichi-
> mi dice che non è una cartella valida
Casanmaner nella sua ultima risposta qui sotto.
===
Regards,
Norman
draleo
Feb 15, 2016, 12:51:16 PM2/15/16
to
Si. anche la procedura di vittorio funzionava; ero io ad aver sbagliato il copia incolla.
Anche le spartane versioni di Bruno ora funzionano senza problemi.
Rimane in sospeso la sub di Norman per rinominare le cartelle
draleo
Anche le spartane versioni di Bruno ora funzionano senza problemi.
Rimane in sospeso la sub di Norman per rinominare le cartelle
draleo
Norman Jones
Feb 15, 2016, 12:52:24 PM2/15/16
to
On 15/02/2016 17:49, Norman Jones wrote:
> A me funziona senza alcun problema ma vedi i commenenti in merito di
> Casanmaner nella sua ultima risposta qui sotto.
> A me funziona senza alcun problema ma vedi i commenti in merito di
> A me funziona senza alcun problema ma vedi i commenenti in merito di
> Casanmaner nella sua ultima risposta qui sotto.
> Casanmaner nella sua ultima risposta qui sopra.
===
Regards,
Norman
Norman Jones
Feb 15, 2016, 1:09:41 PM2/15/16
to
Ciao Draleo,
On 15/02/2016 17:51, draleo wrote:
> Rimane in sospeso la sub di Norman per rinominare le cartelle
Come spiegato, mi sonon limitato a suggerire un altro modo di
selezionare la directory iniziale.
Per rinominare i file potresti sfruttare la dichiarazione Name nel modo:
Name oldpathname As newpathname
come gia indicato in altre soluzioni.
A volte, se vedo che eccellenti suggerimenti siano già stati offerti,
potrei affrontare solo un particolare aspetto con una proposta
alternativa. In tal caso, in assenza di una affermazione esplicita da
parte mia, la proposta alternativa è semplicemente un'alternativa e non
necessariamente meglio dei suggerimenti precedenti.
===
Regards,
Norman
On 15/02/2016 17:51, draleo wrote:
> Rimane in sospeso la sub di Norman per rinominare le cartelle
selezionare la directory iniziale.
Per rinominare i file potresti sfruttare la dichiarazione Name nel modo:
Name oldpathname As newpathname
come gia indicato in altre soluzioni.
A volte, se vedo che eccellenti suggerimenti siano già stati offerti,
potrei affrontare solo un particolare aspetto con una proposta
alternativa. In tal caso, in assenza di una affermazione esplicita da
parte mia, la proposta alternativa è semplicemente un'alternativa e non
necessariamente meglio dei suggerimenti precedenti.
===
Regards,
Norman
draleo
Feb 15, 2016, 1:23:45 PM2/15/16
to
Si; anche la 2° versione di Norman funzionava bene. Probabilmente anche in questo caso avevo sbagliato il copia incolla .
Inoltre pensavo che la sub di Casanmaner per rinominare le cartelle funzionasse solo con la SUA versione di estrazione folder e NON con quella di Norman. Ma dalle prove fatte ho visto che funziona comunque. Bene così.
>Per rinominare i file potresti sfruttare la dichiarazione Name nel modo:
> Name oldpathname As newpathname
> come gia indicato in altre soluzioni.
scusa, mi rendo conto di abusare della tua cortesia, ma sono abbastanza ignorante in materia e non credo di riuscirsi da solo; potresti fare una sub di esempio per estrarre e poi rinominare i files contenuti in una determinata cartella?
draleo
Inoltre pensavo che la sub di Casanmaner per rinominare le cartelle funzionasse solo con la SUA versione di estrazione folder e NON con quella di Norman. Ma dalle prove fatte ho visto che funziona comunque. Bene così.
>Per rinominare i file potresti sfruttare la dichiarazione Name nel modo:
> Name oldpathname As newpathname
> come gia indicato in altre soluzioni.
draleo
draleo
Feb 15, 2016, 2:25:57 PM2/15/16
to
Cercando in questo gruppo ho trovato una vecchia procedura di Norman
che estrae, nella colonna A del foglio1,
i nomi dei files presenti in una determinata cartella : C:\prova
Ma come si fa a rinominarli con dei nomi immessi nella colonna B ?
Public Sub ListFiles()
Dim WB As Workbook
Dim sh As Worksheet
Dim destRng As Range
Dim iCtr As Long
Dim ArrFiles As String
Dim MyPath As String
Dim myFolder As String
myFolder = CurDir
MyPath = "C:\prova" '<<==== da CAMBIARE
ChDrive MyPath
ChDir MyPath
ArrFiles = Dir("*.*")
If Len(ArrFiles) = 0 Then
MsgBox "Non si trova dei file!"
GoTo XIT
End If
On Error GoTo XIT
Application.ScreenUpdating = False
Set WB = ThisWorkbook '<<==== da CAMBIARE
Set sh = WB.Sheets("Foglio1") '<<==== da CAMBIARE
Set destRng = sh.Range("A2") '<<==== da CAMBIARE
Range(destRng, destRng.End(xlDown)).ClearContents
iCtr = 2
Do While ArrFiles <> ""
sh.Cells(iCtr, "A").Value = ArrFiles
iCtr = iCtr + 1
ArrFiles = Dir()
Loop
XIT:
ChDrive myFolder
ChDir myFolder
Application.ScreenUpdating = True
End Sub
che estrae, nella colonna A del foglio1,
i nomi dei files presenti in una determinata cartella : C:\prova
Ma come si fa a rinominarli con dei nomi immessi nella colonna B ?
Public Sub ListFiles()
Dim WB As Workbook
Dim sh As Worksheet
Dim destRng As Range
Dim iCtr As Long
Dim ArrFiles As String
Dim MyPath As String
Dim myFolder As String
myFolder = CurDir
MyPath = "C:\prova" '<<==== da CAMBIARE
ChDrive MyPath
ChDir MyPath
ArrFiles = Dir("*.*")
If Len(ArrFiles) = 0 Then
MsgBox "Non si trova dei file!"
GoTo XIT
End If
On Error GoTo XIT
Application.ScreenUpdating = False
Set WB = ThisWorkbook '<<==== da CAMBIARE
Set sh = WB.Sheets("Foglio1") '<<==== da CAMBIARE
Set destRng = sh.Range("A2") '<<==== da CAMBIARE
Range(destRng, destRng.End(xlDown)).ClearContents
iCtr = 2
Do While ArrFiles <> ""
sh.Cells(iCtr, "A").Value = ArrFiles
iCtr = iCtr + 1
ArrFiles = Dir()
Loop
XIT:
ChDrive myFolder
ChDir myFolder
Application.ScreenUpdating = True
End Sub
casanmaner
Feb 15, 2016, 2:56:43 PM2/15/16
to
draleo personalmente continuerei con la stessa procedura di Norman con possibilità di scelta della cartella (in questo caso scegliendo anch la subfolder dove sono presenti i file):
'------
Public Sub ElencaPath()
Dim WB As Workbook
Dim SH As Worksheet
Dim fso As Object, Files As Object, file As Object
With FirstRng
.Cells(-1).Value = "File nella cartella:"
'------
Poi usi la stessa procedura per rinominare le cartelle solo che al posto di avere il percorso della "cartella principale" avrai il percorso fino alla "subcartella" e al posto della stringa della "subcartella" avrai il nome del nuovo file:
'---
Sub RinominaFile()
Dim FirstRng As Range
Dim i As Long, strPath As String
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi dei file
End Sub
'---
Al file dovrai dare un nuovo nome e anche l'estensione.
Volendo si può fare in modo che tu inserisca solo il nome e poi l'estensione venga presa dal file origine.
Dipende da come si preferisce :-)
Fai qualche test sempre su cartelle e file "copia" ;-)
'------
Public Sub ElencaPath()
Dim WB As Workbook
Dim SH As Worksheet
Dim fso As Object, Files As Object, file As Object
Dim ShellApp As Object
Dim sPath As String
Dim FirstRng As Range, dataRng As Range
Dim i As Long
Dim bProblem As Boolean
Set WB = ThisWorkbook
Set SH = WB.Sheets("Foglio1")
With SH
Set FirstRng = .Range("A3")
Set dataRng = .Range(FirstRng(0), FirstRng.End(xlDown))
End With
dataRng.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Do
bProblem = False
Set ShellApp = CreateObject("Shell.Application"). _
Browseforfolder(0, "SELEZIONA UNA FOLDER", 0, "c:\\")
On Error Resume Next
sPath = ShellApp.self.Path
Set Files = fso.GetFolder(sPath).Files
Dim sPath As String
Dim FirstRng As Range, dataRng As Range
Dim i As Long
Dim bProblem As Boolean
Set WB = ThisWorkbook
Set SH = WB.Sheets("Foglio1")
With SH
Set FirstRng = .Range("A3")
Set dataRng = .Range(FirstRng(0), FirstRng.End(xlDown))
End With
dataRng.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Do
bProblem = False
Set ShellApp = CreateObject("Shell.Application"). _
Browseforfolder(0, "SELEZIONA UNA FOLDER", 0, "c:\\")
On Error Resume Next
sPath = ShellApp.self.Path
If Err.Number <> 0 Then
If MsgBox(Prompt:="Non hai scelto una folder valida!" _
& vbNewLine & vbNewLine & _
"Vuoi riprovare?", _
Buttons:=vbYesNoCancel, _
Title:="CARTELLA NECESSARIA!") <> vbYes Then
Exit Sub
End If
bProblem = True
End If
If MsgBox(Prompt:="Non hai scelto una folder valida!" _
& vbNewLine & vbNewLine & _
"Vuoi riprovare?", _
Buttons:=vbYesNoCancel, _
Title:="CARTELLA NECESSARIA!") <> vbYes Then
Exit Sub
End If
bProblem = True
On Error GoTo 0
Loop Until bProblem = False
i = 0
For Each file In Files
Loop Until bProblem = False
i = 0
With FirstRng.Offset(i)
.NumberFormat = "@"
.Value = CStr(fso.GetFileName(file))
.NumberFormat = "@"
End With
i = i + 1
Next file
i = i + 1
With FirstRng
.Cells(-1).Value = "File nella cartella:"
.Cells(0).Value = sPath
.EntireColumn.AutoFit
End With
End Sub
.EntireColumn.AutoFit
End With
'------
Poi usi la stessa procedura per rinominare le cartelle solo che al posto di avere il percorso della "cartella principale" avrai il percorso fino alla "subcartella" e al posto della stringa della "subcartella" avrai il nome del nuovo file:
'---
Sub RinominaFile()
Dim FirstRng As Range
Dim i As Long, strPath As String
With ThisWorkbook
With .Worksheets("Foglio1") '<--- impostare foglio
strPath = .Range("A2") '<--- impostare cella in cui è indicato il percorso dove sono situati i file
With .Worksheets("Foglio1") '<--- impostare foglio
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi dei file
End With
End With
i = 0
Do While FirstRng.Offset(i) <> ""
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value
End With
i = 0
Do While FirstRng.Offset(i) <> ""
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value
i = i + 1
Loop
End Sub
'---
Al file dovrai dare un nuovo nome e anche l'estensione.
Volendo si può fare in modo che tu inserisca solo il nome e poi l'estensione venga presa dal file origine.
Dipende da come si preferisce :-)
Fai qualche test sempre su cartelle e file "copia" ;-)
casanmaner
Feb 15, 2016, 3:07:58 PM2/15/16
to
Ah cambia il nome della Sub in ElencaFiles :-)
Inoltre ti propongo la procedura di rinomina dei file con l'opzione di inserimento dei nomi dei file senza estesione con assegnazione della stessa in fase di rinomina:
'-----------
Sub RinominaFile2()
Dim FirstRng As Range
Dim i As Long, strPath As String, Ext As String
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value & Ext
Inoltre ti propongo la procedura di rinomina dei file con l'opzione di inserimento dei nomi dei file senza estesione con assegnazione della stessa in fase di rinomina:
'-----------
Sub RinominaFile2()
Dim FirstRng As Range
Dim i As Long, strPath As String, Ext As String
With ThisWorkbook
With .Worksheets("Foglio1") '<--- impostare foglio
strPath = .Range("A2") '<--- impostare cella in cui è indicato il percorso principale
With .Worksheets("Foglio1") '<--- impostare foglio
Set FirstRng = .Range("A3") '<--- impostare la cella di partenza dove inserire i nomi della cartella
End With
End With
i = 0
Do While FirstRng.Offset(i) <> ""
Ext = Mid(FirstRng.Offset(i), InStrRev(FirstRng.Offset(i), ".", -1, vbTextCompare))
End With
i = 0
Do While FirstRng.Offset(i) <> ""
Name strPath & "\" & FirstRng.Offset(i).Value As strPath & "\" & FirstRng.Offset(i, 1).Value & Ext
i = i + 1
Loop
End Sub
'-----------
Loop
End Sub
Norman Jones
Feb 15, 2016, 3:11:17 PM2/15/16
to
Ciao Casanmaner,
> l'estensionevenga presa dal file origine.
+1
===
Regards,
Norman
> Dipende da come si preferisce :-)
>
> Fai qualche test sempre su cartelle e file "copia" ;-)
Sono d'accordo.
>
> Fai qualche test sempre su cartelle e file "copia" ;-)
+1
===
Regards,
Norman
Norman Jones
Feb 15, 2016, 3:31:34 PM2/15/16
to
Ciao Draleo,
In questo thread credo che tu abbia ricevuto ottimi suggerimenti da
Casanamer, Vittorio e Bruno, insieme ad un piccolo intervento da parte
mia; oltre l'ottenimento di una soluzione funzionante, penso ciò sia
stato un buon esempio di lavoro di squadra - anche se io sia stato il
giocatore di riserva!
===
Regards,
Norman
In questo thread credo che tu abbia ricevuto ottimi suggerimenti da
Casanamer, Vittorio e Bruno, insieme ad un piccolo intervento da parte
mia; oltre l'ottenimento di una soluzione funzionante, penso ciò sia
stato un buon esempio di lavoro di squadra - anche se io sia stato il
giocatore di riserva!
===
Regards,
Norman
Bruno Campanini
Feb 15, 2016, 4:16:09 PM2/15/16
to
draleo laid this down on his screen :
vorrei vederti prodigo di laute mance.
Questa elenca i file di una determinata directory
(la DIR si può eventualmente definire con FileDialog)
=============================================
Sub ListFiles_1()
Dim FSO As Scripting.FileSystemObject, FsoFolder As Scripting.Folder
Dim FolderName As String, SheetName As String, i
FolderName = "D:\Dichiarazioni\2011 - Redditi 2010"
' Delete SheetName if exists and create a new one
SheetName = Mid(FolderName, InStrRev(FolderName, "\") + 1)
For Each i In ThisWorkbook.Sheets
If i.Name = SheetName Then
i.Delete
End If
Next
ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
Range("A1").Value = "Full Path"
Range("B1").Value = "Filename"
Range("C1").Value = "Ext"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FsoFolder = FSO.GetFolder(FolderName)
Call RecursiveFile_1(FsoFolder)
Columns.AutoFit
End Sub
Sub RecursiveFile_1(objFolder As Scripting.Folder)
Dim j As Long, i
j = Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each i In objFolder.Files
Cells(j, "A") = Left(i.Path, InStrRev(i.Path, "\") - 1) & "\"
Cells(j, "B") = Mid(i.Path, InStrRev(i.Path, "\") + 1,
Len(Mid(i.Path, InStrRev(i.Path, "\"))) - Len(Mid(i.Path,
InStrRev(i.Path, ".") - 1)))
Cells(j, "C") = Right(i.Path, Len(i.Path) - InStrRev(i.Path, ".") +
1)
End Sub
=============================================
Questa rinomina i file elencati secondo quanto definito
in colonna D
===========================================
Public Sub RenameFiles_1()
Set SourceRange = Range(SourceRange, SourceRange.End(xlDown))
For Each i In SourceRange
Name i & i(1, 2) & i(1, 3) As i & i(1, 4) & i(1, 3)
Next
End Sub
===========================================
Bruno
> Si. anche la procedura di vittorio funzionava; ero io ad aver sbagliato il
> copia incolla. Anche le spartane versioni di Bruno ora funzionano senza
> problemi. Rimane in sospeso la sub di Norman per rinominare le cartelle
Mi pare tu abbia a disposizione tre camerieri di prim'ordine,
> copia incolla. Anche le spartane versioni di Bruno ora funzionano senza
> problemi. Rimane in sospeso la sub di Norman per rinominare le cartelle
vorrei vederti prodigo di laute mance.
Questa elenca i file di una determinata directory
(la DIR si può eventualmente definire con FileDialog)
=============================================
Sub ListFiles_1()
Dim FSO As Scripting.FileSystemObject, FsoFolder As Scripting.Folder
Dim FolderName As String, SheetName As String, i
FolderName = "D:\Dichiarazioni\2011 - Redditi 2010"
' Delete SheetName if exists and create a new one
SheetName = Mid(FolderName, InStrRev(FolderName, "\") + 1)
For Each i In ThisWorkbook.Sheets
If i.Name = SheetName Then
i.Delete
End If
Next
ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
Range("A1").Value = "Full Path"
Range("B1").Value = "Filename"
Range("C1").Value = "Ext"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FsoFolder = FSO.GetFolder(FolderName)
Call RecursiveFile_1(FsoFolder)
Columns.AutoFit
End Sub
Sub RecursiveFile_1(objFolder As Scripting.Folder)
Dim j As Long, i
j = Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each i In objFolder.Files
Cells(j, "A") = Left(i.Path, InStrRev(i.Path, "\") - 1) & "\"
Cells(j, "B") = Mid(i.Path, InStrRev(i.Path, "\") + 1,
Len(Mid(i.Path, InStrRev(i.Path, "\"))) - Len(Mid(i.Path,
InStrRev(i.Path, ".") - 1)))
Cells(j, "C") = Right(i.Path, Len(i.Path) - InStrRev(i.Path, ".") +
1)
j = j + 1
Next
End Sub
=============================================
Questa rinomina i file elencati secondo quanto definito
in colonna D
===========================================
Public Sub RenameFiles_1()
Dim SourceRange As Range, i
Set SourceRange = Sheets("2011 - Redditi 2010").Range("A2")
Set SourceRange = Range(SourceRange, SourceRange.End(xlDown))
For Each i In SourceRange
Name i & i(1, 2) & i(1, 3) As i & i(1, 4) & i(1, 3)
Next
End Sub
===========================================
Bruno
draleo
Feb 15, 2016, 4:22:17 PM2/15/16
to
Sicuramente la prima parte del mio quesito (estrarre le sottocartelle contenute all'interno di una cartella e poi rinominarle) è stato risolto MOLTO efficacemente grazie ai suggerimenti di voi tutti.
Ma per quanto riguarda la parte successiva (estrarre i file contenuti all'interno di una determinata cartella per poi rinominarli ) brancolo ancora al buio (semibuio). Infatti le procedure indicate da voi tutti in questo thread estraggono solo le sottocartelle (ma non i files contenuti al loro interno). Quello che invece serve a me, per questa secondo obbiettivo, sono proprio i nomi dei files contenuti all'interno delle cartelle.
Comunque Sono riuscito a estrarre tali files , trovando su questo gruppo un'altra procedura di Norman -Sub ListFiles()- descritta sopra con la quale ottengo i nomi dei file comprensivi dell'estensione.
Adesso si tratta di rinominarli (facendoli precedere dalla path) e per farlo seguirò quanto indicato da Casanmaner, utilizzando la sua sub :rinominafiles2 .
Ma non sarà facile . Credo di aver capito il meccanismo, ma quello che per voi è facile e risolvibile in poche minuti (o secondi), al sottoscritto richiede ore di ricerche e tentativi (il più delle volte vani).
draleo
Ma per quanto riguarda la parte successiva (estrarre i file contenuti all'interno di una determinata cartella per poi rinominarli ) brancolo ancora al buio (semibuio). Infatti le procedure indicate da voi tutti in questo thread estraggono solo le sottocartelle (ma non i files contenuti al loro interno). Quello che invece serve a me, per questa secondo obbiettivo, sono proprio i nomi dei files contenuti all'interno delle cartelle.
Comunque Sono riuscito a estrarre tali files , trovando su questo gruppo un'altra procedura di Norman -Sub ListFiles()- descritta sopra con la quale ottengo i nomi dei file comprensivi dell'estensione.
Adesso si tratta di rinominarli (facendoli precedere dalla path) e per farlo seguirò quanto indicato da Casanmaner, utilizzando la sua sub :rinominafiles2 .
Ma non sarà facile . Credo di aver capito il meccanismo, ma quello che per voi è facile e risolvibile in poche minuti (o secondi), al sottoscritto richiede ore di ricerche e tentativi (il più delle volte vani).
draleo
Bruno Campanini
Feb 15, 2016, 4:37:57 PM2/15/16
to
Bruno Campanini wrote on 15-02-16 :
che è lo chef internazionale.
Bruno
> draleo laid this down on his screen :
>> Si. anche la procedura di vittorio funzionava; ero io ad aver sbagliato il
>> copia incolla. Anche le spartane versioni di Bruno ora funzionano senza
>> problemi. Rimane in sospeso la sub di Norman per rinominare le cartelle
>
> Mi pare tu abbia a disposizione tre camerieri di prim'ordine,
> vorrei vederti prodigo di laute mance.
>
Ho detto tre intendendo escludere Norman
>> Si. anche la procedura di vittorio funzionava; ero io ad aver sbagliato il
>> copia incolla. Anche le spartane versioni di Bruno ora funzionano senza
>> problemi. Rimane in sospeso la sub di Norman per rinominare le cartelle
>
> Mi pare tu abbia a disposizione tre camerieri di prim'ordine,
> vorrei vederti prodigo di laute mance.
>
che è lo chef internazionale.
Bruno
casanmaner
Feb 15, 2016, 4:40:13 PM2/15/16
to
draleo
Feb 15, 2016, 4:43:27 PM2/15/16
to
Quando ho scritto il post precedente non avevo ancora letto l'ultima di Bruno.
l'ho provata ed è ECCEZIONALE ! mi farà risparmiare almeno un paio di nottate davanti al PC. Ma la cospicua mancia sarebbe una cosa troppo venale e offensiva per voi Maestri (è più nobile un mazzo di fiori, va bene?). Scherzo,naturalmente. Una cena ? facendosi servire da camerieri veri ?
Grazie infinite
draleo
l'ho provata ed è ECCEZIONALE ! mi farà risparmiare almeno un paio di nottate davanti al PC. Ma la cospicua mancia sarebbe una cosa troppo venale e offensiva per voi Maestri (è più nobile un mazzo di fiori, va bene?). Scherzo,naturalmente. Una cena ? facendosi servire da camerieri veri ?
Grazie infinite
draleo
casanmaner
Feb 15, 2016, 5:16:26 PM2/15/16
to
Per continuare l'"esercizio" ...poiché io sono un pigro e non mi va di spremermi per "estrarre" stringhe di testo e considerato che sfrutto "Scripting.FileSystemObject" allora vedo di farlo fino in fondo :-)
Modificando la procedura di Bruno così:
'---------
Sub RecursiveFile_1(FSO As Object, objFolder As Object)
Cells(j, "B") = FSO.GetBaseName(i)
Cells(j, "C") = "." & FSO.GetExtensionName(i)
Ovviamente questa modifica comporterà anche la modifica alla riga della precedente Sub ListFiles_1 nella riga che richiama RecursiveFile_1 impostando entrambi gli argomenti:
Call RecursiveFile_1(FSO, FsoFolder)
:-)
Modificando la procedura di Bruno così:
'---------
Sub RecursiveFile_1(FSO As Object, objFolder As Object)
Dim j As Long, i
j = Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each i In objFolder.Files
Cells(j, "A") = FSO.GetParentFolderName(i) & "\"
j = Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each i In objFolder.Files
Cells(j, "B") = FSO.GetBaseName(i)
Cells(j, "C") = "." & FSO.GetExtensionName(i)
j = j + 1
Next
End Sub
'----------
Next
End Sub
Ovviamente questa modifica comporterà anche la modifica alla riga della precedente Sub ListFiles_1 nella riga che richiama RecursiveFile_1 impostando entrambi gli argomenti:
Call RecursiveFile_1(FSO, FsoFolder)
:-)
casanmaner
Feb 15, 2016, 6:12:02 PM2/15/16
to
Poi volendo, eventualmente da implementare con la selezione della cartella principale come da esempio di Normam, la procedura di Bruno potrebbe essere modificata per leggere tutte le sottocartelle della cartella principale e elencare tutti i file di ciascuna sottocartella in fogli distinti.
Questa la "mia reinterpretazione":
'-------------
Public Const strFolder = "C:\Users\Utente\Desktop\Cartel0" '<==== cartella principaleSub ListFiles_InAllSubFolder()
Dim FSO As Object, FsoFolder As Object, FsoSubFolder As Object
Worksheets(1).Cells.Clear
Application.DisplayAlerts = False
For nws = Worksheets.Count To 2 Step -1
Worksheets(nws).Delete
Next
Application.DisplayAlerts = True
FolderName = strFolder
For Each FsoSubFolder In FsoFolder.SubFolders
If nws > 1 Then Worksheets.Add After:=Worksheets(nws - 1)
With ActiveSheet
.Name = FSO.GetBaseName(FsoSubFolder)
.Range("A1").Value = "Full Path"
.Range("B1").Value = "Filename"
.Range("C1").Value = "Ext"
Call RecursiveFile_1(FSO, FsoSubFolder)
.Columns.AutoFit
End With
nws = nws + 1
Next FsoSubFolder
End Sub
'-------------
Questa la "mia reinterpretazione":
'-------------
Public Const strFolder = "C:\Users\Utente\Desktop\Cartel0" '<==== cartella principaleSub ListFiles_InAllSubFolder()
Dim FSO As Object, FsoFolder As Object, FsoSubFolder As Object
Dim FolderName As String, SheetName As String, i
Dim nws As Integer
Worksheets(1).Cells.Clear
Application.DisplayAlerts = False
For nws = Worksheets.Count To 2 Step -1
Worksheets(nws).Delete
Next
Application.DisplayAlerts = True
FolderName = strFolder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FsoFolder = FSO.GetFolder(FolderName)
nws = 1
Set FsoFolder = FSO.GetFolder(FolderName)
For Each FsoSubFolder In FsoFolder.SubFolders
If nws > 1 Then Worksheets.Add After:=Worksheets(nws - 1)
With ActiveSheet
.Name = FSO.GetBaseName(FsoSubFolder)
.Range("A1").Value = "Full Path"
.Range("B1").Value = "Filename"
.Range("C1").Value = "Ext"
Call RecursiveFile_1(FSO, FsoSubFolder)
.Columns.AutoFit
End With
nws = nws + 1
Next FsoSubFolder
End Sub
'-------------
Bruno Campanini
Feb 15, 2016, 8:31:51 PM2/15/16
to
casanmaner expressed precisely :
Hai perfettamente ragione, ho già corretto la mia versione
in tal senso.
Cerco la via più breve ma questa volta ho proprio scelto
la più lunga (ed anche la più complicata: a scriver quelle
tre righe ho impiegato un sacco di tempo).
Senectus ipsa morbus...
Bruno
in tal senso.
Cerco la via più breve ma questa volta ho proprio scelto
la più lunga (ed anche la più complicata: a scriver quelle
tre righe ho impiegato un sacco di tempo).
Senectus ipsa morbus...
Bruno
Bruno Campanini
Feb 15, 2016, 8:44:47 PM2/15/16
to
draleo has brought this to us :
i nostri IBAN.
Considerando però le complicazioni contabili e fiscali direi,
non so se anche gli altri sian d'accordo, che il ringraziamento
toto corde che hai espresso può sicuramente considerarsi a saldo
e transazione del rapporto.
Alla prossima Dottore.
Bruno
> Quando ho scritto il post precedente non avevo ancora letto l'ultima di
> Bruno. l'ho provata ed è ECCEZIONALE ! mi farà risparmiare almeno un paio di
> nottate davanti al PC. Ma la cospicua mancia sarebbe una cosa troppo venale e
> offensiva per voi Maestri (è più nobile un mazzo di fiori, va bene?).
> Scherzo,naturalmente. Una cena ? facendosi servire da camerieri veri ?
> Grazie infinite draleo Il giorno lunedì 15 febbraio 2016 22:37:57 UTC+1,
La cosa più nobile in assoluto sarebbe che ti mandassimo
> Bruno. l'ho provata ed è ECCEZIONALE ! mi farà risparmiare almeno un paio di
> nottate davanti al PC. Ma la cospicua mancia sarebbe una cosa troppo venale e
> offensiva per voi Maestri (è più nobile un mazzo di fiori, va bene?).
> Scherzo,naturalmente. Una cena ? facendosi servire da camerieri veri ?
> Grazie infinite draleo Il giorno lunedì 15 febbraio 2016 22:37:57 UTC+1,
i nostri IBAN.
Considerando però le complicazioni contabili e fiscali direi,
non so se anche gli altri sian d'accordo, che il ringraziamento
toto corde che hai espresso può sicuramente considerarsi a saldo
e transazione del rapporto.
Alla prossima Dottore.
Bruno
casanmaner
Feb 16, 2016, 2:11:25 AM2/16/16
to
La ripropongo completa:
'-------------------
draleo
Feb 16, 2016, 2:58:45 PM2/16/16
to
Questo non l'ho capito:
draleo
Il giorno martedì 16 febbraio 2016 00:12:02 UTC+1, casanmaner ha scritto:
> eventualmente da implementare con la selezione della cartella principale come > da esempio di Normam, la procedura di Bruno potrebbe essere modificata per >leggere tutte le sottocartelle della cartella principale e elencare tutti i > file di ciascuna sottocartella in fogli distinti.
potresti postare il codice con queste implementazioni ?
draleo
Il giorno martedì 16 febbraio 2016 00:12:02 UTC+1, casanmaner ha scritto:
casanmaner
Feb 16, 2016, 3:10:50 PM2/16/16
to
draleo ... intendevo la parte della procedura di Norman che apre la shell per scegiere la cartella.
Quindi hai già tutto ;-)
Quindi hai già tutto ;-)
casanmaner
Feb 16, 2016, 4:14:36 PM2/16/16
to
Il giorno martedì 16 febbraio 2016 21:10:50 UTC+1, casanmaner ha scritto:
> draleo ... intendevo la parte della procedura di Norman che apre la shell per scegiere la cartella.
> Quindi hai già tutto ;-)
Comunque intendevo qualcosa del genere (a differenza della procedura di Norman utilizzo il FileDialog perché della shell non conosco metodi e proprietà :-)).
> draleo ... intendevo la parte della procedura di Norman che apre la shell per scegiere la cartella.
> Quindi hai già tutto ;-)
'---
Sub SelezionaFolder()
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
If .Show = False Then Exit Sub
End With
strFolder = FD.SelectedItems(1)
Call ListFiles_InAllSubFolder
End Sub
'---
Message has been deleted
casanmaner
Feb 16, 2016, 4:22:21 PM2/16/16
to
Ad essere pignoli meglio scritta così:
End With
Call ListFiles_InAllSubFolder
End Sub
Sub SelezionaFolder()
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
If .Show = False Then Exit Sub
strFolder = .SelectedItems(1)
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
If .Show = False Then Exit Sub
End With
Call ListFiles_InAllSubFolder
End Sub
Ammammata
Feb 17, 2016, 5:51:43 AM2/17/16
to
Il giorno Sun 14 Feb 2016 11:41:38a, *draleo* inviava su
microsoft.public.it.office.excel il messaggio news:e8345c45-c469-4115-81fd-
e0a630...@googlegroups.com. Vediamo cosa scrisse:
> per il punto 1 leggerò il link sperando di capirci qualcosa
>
...e già che farai 30 potresti fare 31:
http://wiki.news.nic.it/QuotarBene :)
--
/-\ /\/\ /\/\ /-\ /\/\ /\/\ /-\ T /-\
-=- -=- -=- -=- -=- -=- -=- -=- - -=-
>>>>> http://www.bb2002.it :) <<<<<
........... [ al lavoro ] ...........
microsoft.public.it.office.excel il messaggio news:e8345c45-c469-4115-81fd-
e0a630...@googlegroups.com. Vediamo cosa scrisse:
> per il punto 1 leggerò il link sperando di capirci qualcosa
>
...e già che farai 30 potresti fare 31:
http://wiki.news.nic.it/QuotarBene :)
--
/-\ /\/\ /\/\ /-\ /\/\ /\/\ /-\ T /-\
-=- -=- -=- -=- -=- -=- -=- -=- - -=-
>>>>> http://www.bb2002.it :) <<<<<
........... [ al lavoro ] ...........
0 new messages