XL 2010 Macro pour remplacer caractères spéciaux dans noms de fichiers

[Tech]

Bonjour chers amis du forum,

Cela fait bien longtemps que je ne suis pas passé par ici.
Eh oui, la vie (qui n'est pas toujours drôle) fait qu'on doit s'éloigner de nos passions et des choses qu'on aime faire pour différentes raisons. Pour moi, c'est une maladie de m... je reste poli. Elle porte l'acronyme sep pour ceux qui connaissent.
Quoi qu'il en soit, je suis fortement diminué maintenant à cause de cette s......
mais bon revenons à nos moutons.
Comme énoncé dans le titre, je cherche à créer un automatisme pour remplacer les caractères interdits par une appli de synchro.
les fichiers sont des mp3 ou des flac.
ne connaissant (vaguement) que le VBA, je me suis tourné vers ce langage.
après qlqes recherches sur le net, j'ai fini par trouver ceci que j'ai légèrement adapté :

Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, strf2 As String

Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "T:\"

For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
For Each f2 In f1.Files
strf2 = f2
If InStr(strf2, "é") <> 0 Then
strf2 = Replace(strf2, "é", "e")
f2.Name = strf2
End If
Next f2
Next f1
End Sub

En fait, ça à l'air de fonctionner mais presque...
Ce code renvoie une erreur à la ligne f2.Name = strf2.
Apparemment on ne peut pas écrire sur la propriété .name d'un objet. Je croyais pourtant cela possible.

Je me doute que c'est un sujet déjà abordé sur ce forum, mais avec la fonction de recherche, je n'ai rien trouvé.
quelqu'un aurait il une explication ?

 

[pierrejean]

Bonjour Tech
pourquoi faire simple.....

For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
  For Each f2 In f1.Files
      If InStr(f2.Name, "é") <> 0 Then
          f2.Name = Replace(f2.Name, "é", "e")
      End If
  Next f2
Next f1

 

[Tech]

Bonjour pierrejean.
Merci beaucoup pour ta réponse. Effectivement, pourquoi faire compliqué surtout
C'est bien beau tout ça, mais maintenant je me rend compte de deux problèmes.
Déjà, ce code boucle sur 2 niveaux de sous dossiers or j'ai plus de deux niveaux dans le disque ou je veux appliquer le code. Une idée pour passer tous les dossiers d'un disque à la moulinette ?
Ensuite, il y à plusieurs caractères refusés par mon appli de synchro. Comment faire pour vérifier la présence d'un é, d'un è, d'une ', d'un - dans la même ligne , ou je dois faire plusieurs commandes Instr ?

En fait non, trois problèmes.
Les noms des sous dossiers peuvent aussi contenir un de ces caractères interdits. Savez vous comment je peux traiter les noms de dossiers avec le même code ,

Merci d'avance pour vos réponses

 

[pierrejean]

RE

A tester:

Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, strf2 As String

Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = ThisWorkbook.Path ' a adapter

For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
  For Each f2 In f1.Files
     f2.Name = MajSansAccent$(f2.Name)

   Next f2
Next f1
End Sub
Function MajSansAccent$(ByVal Chaine$)
'Ti
Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûü", VSsAccent = "aaaaaaeeeeiiiioooooouuuu"
Dim Bcle&
If Len(Chaine) > 0 Then
For Bcle = 1 To Len(VAccent)
Chaine = Replace(Chaine, Mid(VAccent, Bcle, 1), Mid(VSsAccent, Bcle, 1))
Next Bcle
MajSansAccent = Chaine
End If
End Function

 

[Tech]

RE PJ,
y'a pas à dire, tu gères
J'ai testé mais malheureusement, il me renvoie une erreur à la ligne f2.Name = MajSansAccent$(f2.Name).
il me semble que c'est l'appel de la fonction. l'erreur c'est "le fichier existe déjà".

j'ai poussé un peu les recherches et en fait le fichier qu'il essaie de traiter au moment de l'erreur est desktop.ini. Alors qu'il n'y à aucun fichier de ce type dans le dossier sur lequel je veux exécuter la macro. (j'ai affiché les fichiers et dossiers cachés).
Je me souvient, windaube causait déjà des trucs comme ça il y à qlqes années. Mais je ne souvient pas de la solution...

une idée ?

 

[Tech]

Rebonjour les amis.

bon, comme je me sens un peu abandonné, je vais poser mes questions autrement.

Je voudrais savoir si il est possible de boucler sur tous les dossiers, sous-dossiers et sous sous dossiers peu importe le niveau ainsi que sur les fichiers contenus dans un lecteur.

Je m'explique : 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é)

Malheureusement, avant, je savais faire ça mais maintenant, je ne sais plus et je m'en sens plus capable (j'explique pourquoi dans le premier message de ce post).

Voilà. Peut être que tout cela n'a rien à faire dans un forum dédié à Excel et au vba mais si quelqu'un comprend ma demande et a une solution à me proposer, je suis preneur

Bonne nuit à tous.

 

[Tech]

bonjour le fofo,
N'ayant pas de réponse à ma question ci dessus, j'ai creusé un peu le net.
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 le modifier 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.
quelqu'un aurait-il une idée ?
Merci pour vos réponses

 

[Tech]

hey, c'est encore moi...
pas de réponse ? mmmmm.
Alors pour poser la question simplement, est il possible une fois qu'on à lu le nom d'un fichier, de modifier le nom lu et de le réécrire en tant que nom de fichier sur le même fichier ? Tout ça avec du code vba ?
Merci pour vos réponses

 

[patricktoulon]

re
bonjour
je n'en suis pas sur mais je crois que ca déclencherait une erreur justement

que se soit avec une fonction recursive avec dir ou scriptingfilesystemobject
tout simplement parceque si tu change pendant la boucle tu modifie l'arborescence et donc la boucle ayant démarréavec une arborescence différente va clacher!!

je te suggère de créer un tableau de nom de fichier(array) dans ta boucle et reboucler sur cet array et tout simplement utilise la fonction name

 

[Tech]

Salut.
Merci pour ta réponse Patricktoulon.
Je vois ce que tu veux dire. C'est vrai que si on change les caractéristiques d'une boucle pendant son exécution on risque très certainement de faire planter cette boucle.
J'avoue que je n'y avais pas pensé.
Je vais essayer de faire comme tu proposes mais je crains qu'il puisse y avoir des noms de fichiers inversés.
Mais il n'y a aucun risque à essayer. Je verrai ce que ça donne.
Je ferai un retour de mon résultat.
Good night.

 

[Tech]

Bonjour à tous.
Après les échanges ci dessus, j'ai changé mon fusil d'épaule et essayé d'appliquer les conseils de patricktoulon .
j'ai donc modifié le code afin d'obtenir une liste complète ( et corrigée ) de ce qui se trouve dans mon disque T:\.

voici le code (qui fonctionne)

Dim ligne, StrNom As String
Sub arborescence()
  Application.ScreenUpdating = False
  racine = "T:\"
  Columns("a").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.GetFolder(racine)
  ligne = 1
  Lit_dossier dossier_racine, 1
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
  StrNom = dossier.Path
  ChangeCar
  Cells(ligne, 1) = StrNom
  ligne = ligne + 1
  For Each f In dossier.Files
  StrNom = f.Path
  ChangeCar
If Not f.Attributes And vbHidden Then
     Cells(ligne, 1) = StrNom
     ligne = ligne + 1
End If
  Next
  For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
  Next
End Sub

Sub ChangeCar()
If InStr(StrNom, "é") <> 0 Then StrNom = Replace(StrNom, "é", "e")
If InStr(StrNom, "è") <> 0 Then StrNom = Replace(StrNom, "è", "e")
If InStr(StrNom, "'") <> 0 Then StrNom = Replace(StrNom, "'", " ")
If InStr(StrNom, "ô") <> 0 Then StrNom = Replace(StrNom, "ô", "o")
If InStr(StrNom, "Ô") <> 0 Then StrNom = Replace(StrNom, "Ô", "O")
If InStr(StrNom, "ê") <> 0 Then StrNom = Replace(StrNom, "ê", "e")
End Sub

Bon, je suis d'accord, ce n'est pas super propre, mais ça marche... En tout cas pour récupérer la liste de mes fichiers.

Maintenant, avec cette liste, je voudrais renommer chaque fichier et dossier de mon disque.
Deux problèmes se posent :
premièrement, ça, je sais pas faire...
et deuxièmement, la liste que je récupère ne respecte pas l'ordre des fichiers dans le disque. Donc, j'ai peur qu'en faisant une boucle avec vba pour renommer les fichiers, les noms des fichiers soient complètement inversés et qu'ils ne reflètent plus du tout la réalité.

voici les cinq premières lignes du tableau produit par ce code :

T:\

T:\Tryo

T:\Tryo\1998 - Tryo - Mamagubida

T:\Tryo\1998 - Tryo - Mamagubida\05 - Tryo - La revolution (Live).mp3

T:\Tryo\1998 - Tryo - Mamagubida\06 - Tryo - Regardez-les (Live).mp3

Comme on peut le constater, la première correspond à a lettre du lecteur, la seconde et la troisième, aux dossiers et sous dossiers qui se trouvent sous la racine et les deux dernières à des fichiers qui se trouvent dans le sous dossier.

Ensuite, moi, ce qui m'interpelle, c'est que ces deux premières lignes que j’appellerai "Titres" ne correspondent pas au deux premiers fichiers. En effet, l'album commence bien à la piste une ! Ce qui me fait penser qu'il risque d'y avoir inversion.

Qu'en pensez-vous ?

 

[Tech]

Bonne progression ce soir.
une fois les dossiers de musique copiés sur mon serveur FTP, j'utilise une petite variante du code qui liste l'arborescence dans un disque, ensuite, je remplace les caractères indésirables par un autre code et enfin par une fonction de recherche, je remplace les noms des fichiers dans le serveur.
pour l'instant, j'ai encore un problème si c'est le nom de dossier qui contient un accent, mais je suis confiant. j'y arriverai...