Renommer fichiers dans plusieurs sous-répertoires

Question

J'ai trouvé un fichier qui permet de renommer des fichiers dans un répertoire en fonction d'une liste,. Moi je cherche a renommer un fichier dans plusieurs sous répertoires, dans un même répertoire, mais je ne sais pas comment faire en sorte que la macro prenne en compte les sous répertoires, Je mets en pièce jointe une copie du fichier avec en colonne "A" le nom du fichier à remplacer (il est toujours nommé ainsi, même si les données sont différentes), en colonne "B" le nom que je voudrais attribuer et en colonne "I" la cible du dossier à renommer D'avance je vous remercie pour votre aide et votre attention...

fred2406 · Answer

Peut etre utliser un code qui scrute tous les fichiers a partir d'un dossier parent ? utilisation en récursif pour passé en revu les sous dossiers.... voici un code que j'ai utilisé il y a quelques temps pour lire des données dans tous les fichiers a partir d'un dossier cela pourrait peut-être te servir a+ fred Sub Parcourir_dossiers_recup_donnees(chemin As String, fichier_source As String) 'Déclaration des variables Dim Fso As Scripting.FileSystemObject Dim SourceFolder As Scripting.Folder Dim SubFolder As Scripting.Folder Dim FileItem As Scripting.File Set Fso = CreateObject("Scripting.FileSystemObject") Set SourceFolder = Fso.GetFolder(chemin) 'Boucle sur tous les fichiers du répertoire For Each FileItem In SourceFolder.Files If FileItem.Name&lt;&gt; fichier_source Then: lire_donnees Next FileItem 'fichier suivant '--- Appel récursif pour lister les fichier dans les sous-dossiers du dossier indiquer ---. For Each SubFolder In SourceFolder.SubFolders Parcourir_dossiers_recup_donnees SubFolder.Path, (fichier_source) Next SubFolder End Sub...

fred2406 · Answer

Je viens de regarder un peu plus près ton fichier... dis moi si j'ai bien compris tu as un fichier qui s'appel toujours "fiber_info_otdr.txt" qui est stocker dans un plusieurs dossiers \PB PT 00XXXX\ les XXXX représentant tes numéros 3217,3218,.... et donc si j'ai bien compris tu voudrais renommer le fichier "fiber_info_otdr.txt" comme le nom du dossier le contenant donc exemple pour le premier \PB PT 003217\fiber_info_otdr.txt cela devient "\PB PT 003217\PB PT 003217.txt" est-ce que c'est cela ??? question supplémentaire, y-a-t-il d'autres fichiers dans ces dossiers ?? Car j'ai bien une petite idée de comment faire.... mais sans utiliser ton tableau de correspondance.... fred...

fred2406 · Answer

Re

sans avoir attendu ton retour voici une macro qui fait ce que j'ai dis... reste a mettre un enregistrement si tu veux savoir le le fichier a été renommé.....

fred

Option Explicit

Public oFSO As Object
Public ficS As String
Sub demande_dossier()
Set oFSO = CreateObject("Scripting.FileSystemObject")
ficS = "fiber_info_otdr.txt"
parcourir (ChoixDossier)
End Sub
Sub parcourir(chemin As String)
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Set SourceFolder = oFSO.GetFolder(chemin)
'MsgBox SourceFolder.Name
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
         If FileItem.Name = ficS Then: renomme_fichier Replace(SourceFolder.Path, ficS, "") & "\" & SourceFolder.Name & ".txt", FileItem.Path
Next FileItem 'fichier suivant

'--- Appel récursif pour lister les fichier dans les sous-dossiers du dossier indiquer  ---.
For Each SubFolder In SourceFolder.SubFolders
     parcourir SubFolder.Path
Next SubFolder

End Sub
Sub renomme_fichier(newname As String, EmplacementFich As String)
'renommage du fichier
oFSO.Movefile EmplacementFich, newname
End Sub
Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choisir le dossier de destination"
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

93eole.zip (14.83 Ko)

fred2406 · Answer

Oui c'est possible, il faut ouvrir le fichier avec Excel (import d'un fichier txt) et ensuite l'enregistrer au format Xslx Fred...

fred2406 · Answer

Ou tu peux le faire ici : Sub renomme_fichier(newname As String, EmplacementFich As String) 'renommage du fichier oFSO.Movefile EmplacementFich, newname newnamexls = replace (newname,".txt",".xlsx") 'ouverture du fichier newname 'enregistrement sous newnamexls 'fermeture du fichier xls End Sub fred...

fred2406 · Answer

Bonjour. Non ce bout de code ne permet que de préparer le chemin+ le nom en excel pour faire la sauvegarde. ...

d'ailleurs le nom de la variable créée est newnamexls.... cela veut tout dire .... non ?

Es tu capable de faire ce bout de code ?

Fred

fred2406 · Answer

Je regarderais ce soir ... fred...

fred2406 · Answer

Donc voici le code pour ouvrir le fichier txt et l'enregistrer au format xlsx y a plus qu'a faire des tests fred Sub renomme_fichier(newname As String, EmplacementFich As String) Dim newnamexls As String 'renommage du fichier oFSO.Movefile EmplacementFich, newname newnamexls = Replace(newname, ".txt", ".xlsx") Workbooks.OpenText Filename:=newname, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True ActiveWorkbook.SaveAs Filename:=newnamexls, FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close False End Sub...