Renommer des dossiers et fichiers par macro

bonjour le fofo,

Je cherche un moyen de renommer une série de dossiers et fichiers avec un automatisme. Ne connaissant (vaguement) que le vba, je me suis tourné vers ce langage.

J'explique le but de la manœuvre :

Je voudrais synchroniser le dossier "Musique" qui se trouve dans mon smartphone avec un disque qui se trouve sur un serveur nas. Pour se faire, j'ai trouvé une appli a installer sur le tel qui s'appelle FolderSync.

La synchro avec le serveur (paramétré en FTP) fonctionne très bien mais, bien sur il y à un mais.

En fait, les noms de certains dossiers et fichiers à synchroniser contiennent des accents, des tirais, des apostrophes et autres joyeusetés que FolderSync refuse de gérer. C'est là que je me suis mis en tête d'utiliser vba pour remplacer ces caractères indésirables directement dans le nas. (les e avec accent par des e sans accent, les apostrophes et les tirais par des espaces, les a avec accent par des a sans accent et surement d'autres que n'ai pas encore identifié)

Je suis tombé sur le site "boisgontierjacques" qui m'apporte un bon début de solution.

Le code ci dessous liste l'ensemble des fichiers, dossiers et sous dossiers à partir d'un emplacement : (source http://boisgontierjacques.free.fr/)

Dim ligne
Sub arborescence()
  Application.ScreenUpdating = False
  racine = ChoixDossier() ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A3:E20000").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.GetFolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
  Cells(ligne, 1) = String(4 * (niveau - 1), " ") & "[" & dossier.Path & "]"
  Cells(ligne, 2) =dossier.Size
  Cells(ligne, 4) = dossier.Files.Count
  Cells(ligne, 1).Interior.ColorIndex = 36
  ligne = ligne + 1
  For Each f In dossier.Files
     Cells(ligne, 1) = String(4 * niveau, " ") & f.Name
     Cells(ligne, 1).Interior.ColorIndex = xlNone
     Cells(ligne, 2) = f.Size
     Cells(ligne, 3) = f.DateLastModified
     Cells(ligne, 4) = f.Attributes
     If f.Attributes And vbHidden Then Cells(ligne, 5) = "Caché"
     ligne = ligne + 1
  Next
  For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
  Next
End Sub

Function ChoixDossier()
  If Val(Application.Version) >= 10 Then
    With Application.FileDialog(msoFileDialogFolderPicker)
     .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

La où j'ai besoin de votre aide, c'est pour modifier ce code selon mes besoins.

Je voudrais qu'au lieu d'écrire le nom de chaque élément sur une feuille excel, le code vérifie la présence d'un caractère spécial (accent, tirait, apostrophe...) et le remplace par le caractère que j'aurais mis en correspondance.

Ça j'arrive à le faire en inscrivant le nom dans une variable, mais je ne sais pas comment faire pour agir directement sur le nom du fichier ou dossier. Je me demande même si c'est possible.

J'espère avoir été assez explicite. quelqu'un aurait-il une idée ?

Merci pour vos réponses

Bonjour,

pas certaine d'avoir compris la demande... à voir...donne un exemple à faire pour plus de précision

pour renommer un fichier

Rep= "C:\Users\blabla\"
NomFich = "X"
NewName = "Y"
Name Rep & NomFich As Rep & NewName

pour une correction de caractère

voici un exemple

Select Case KeyAscii 'ou dans une boucle chaque caractère d’une variable

'autorise les caractères suivant

    Case 97 To 122   ' Caracteres minuscule
    Case 65 To 90    ' Caracteres majuscule
    Case 95          ' Caractères tiret bas
    Case 48 To 57    ' nombre de 0 à 9

 'remplace dans la variable les caractères accentués par un équivalent sans accent.

    Case Is = 124: KeyAscii = 95  ' si "|" on remplace par "_"
    Case Is = 232: KeyAscii = 101 ' è  'e
    Case Is = 233: KeyAscii = 101 ' é
    Case Is = 234: KeyAscii = 101 ' ê
    Case Is = 235: KeyAscii = 101 ' ë
    Case Is = 224: KeyAscii = 97  ' à ' a
    Case Is = 226: KeyAscii = 97  ' â
    Case Is = 228: KeyAscii = 97  ' ä
    Case Is = 181: KeyAscii = 117 ' µ' u
    Case Else: KeyAscii = 0       ' aucune saisie possible
End Select

Bonjour à tous,

tu devrais tester Synchronize Ultimate.

Je l'utilise depuis plusieurs années et il est vraiment très complet et performant. J'ai même payé pour l'encourager (et ôter la pub), c'est dire

Aucun problème d'accent pour ma part.

eric

Bonjour Isabelle.

Je te remercie pour ta réponse.

Je ne vais pas pouvoir te donner des exemples mais je vais apporter des précisions.

Je ne sais pas si tu as essayé le code que j'ai montré dans mon premier message.

En fait j'ai un disque dédié à la synchro en question. Chez moi c'est le disque "T:/".

Dans ce disque pour mes essais j'ai copié le dossier Tryo. Ce dossier contient 10 sous-dossiers qui eux mêmes contiennent entre 15 et 22 fichiers.

On retrouve des caractères interdits dans les noms de certains sous-dossiers et les noms de certains fichiers.

Lorsque j'applique le code de mon premier message, celui-ci balaye tout ce qui est contenu dans le disque T et rempli une feuille Excel avec l'arborescence complète du disque T.

À ce moment-là il n'y a pas de correction de caractère.

J'ai déjà fait des essais en apportant une fonction replace dans les boucles qui écrivent ces noms dans la feuille Excel.

Par contre comme expliqué dans mon premier message je ne peux qu'agir sur ce qui est écrit dans la feuille Excel.

Ce que je voudrais c'est agir sur le nom du dossier et du fichier qui pose problème.

Après discussion avec d'autres passionnés de Excel, ça risque d'être plutôt compliqué.

En effet les noms des dossiers et fichiers constituent la structure de plusieurs boucles.

Si je modifie ces noms pendant l'exécution de ces boucles, elles vont très certainement planter.

En fait la solution sera certainement de remplir un tableau array pendant l'exécution des boucles du code ci-dessus puis de remplacer les noms pendant l'exécution d'une autre boucle avec la fonction name.

Voilà. Je comprends bien que ce que je veux faire c'est plutôt compliqué. Je vais m'atteler à la tâche essayer de faire comme je viens de le décrire. Je verrai si j'y arrive.

En tout cas merci pour ta réponse je clique sur résolu bien que ce ne le soit pas encore réellement

Bonne journée.

Bonjour Ériiic.

Merci beaucoup pour ton conseil je vais aussi tester tout cela.

Bonne journée.😁

Re eriiic .

J'ai testé l'appli dont tu parle. effectivement, très complète, voir trop...

par contre, je retrouve le même pb avec les accents.

j'ai essayé de tout corriger " a la mano " avant de faire une synchro, et là ça marche. j'ai pas testé mais je pense qu'avec foldersync aussi.

peu être un pb sur mon phone...

Tu as un message d'erreur sur un accent ?

J'ai testé avec un "é" de android vers Nas et le fichier était correct.

Pour info c'est un Nas Synology, des fois que tu puisses mettre en cause le logiciel du Nas (?)

eric

Salut Ériiic.

En fait je n'ai pas réellement de message d'erreur. le fichier contenant un accent ne se synchronise pas. Et il passe un temps fou sur ce fichier.

Je mets deux images des log de synchronize Ultimate

L'une reprend tout ce qu'il y a été copié et l'autre reprend tous les fichiers sur lesquels j'ai une erreur.

J'ai aussi un Synology ds209. Du vieux matériel mais qui marche toujours très bien.

Je ne sais pas quoi mettre en cause par rapport à ce problème. Je cherche juste à mettre en place un automatisme par VBA qui supprimerai tous ces accents.

Et j'avoue je galère un peu...

Ben je sais pas j'ai ajouté 2 images mais visiblement elle ne passent pas