renommer en masse

[ptibaz]

bonjour à tous!

voici ce que je veux faire en VBA:

dans un dossier, j'ai des 135 fichiers .txt et 135 fichiers .mp3
ces fichiers s'appellent
001.txt
001.mp3
002.txt
002.mp3
003.txt
003.mp3

jusqu'a

135.txt
135.mp3

je veux renommer tous ces fichiers avec la premiere ligne du fichier texte

par exemple
001.txt devient titre bidon.txt
et 001.mp3 devient titre bidon.mp3

titre bidon étant la première ligne du fichier texte 001.txt

et ainsi de suite pour les 135 fichiers.

pouvez vous m'aider s'il vous plait.... merci d'avance

 

[Dormeur74]

Re : renommer en masse

Je vais te donner un coup de main partiel en ne traitant que les fichiers TXT. A toi de travailler pour les fichiers MP3.
Ne mets pas le fichier Excel contenant ta ou tes macros dans le dossier des fichiers sources. Tu peux mettre, par exemple, les fichiers TXT et MP3 dans un dossier nommé "c:\origine" et le fichier Excel dans un dossier "c:\destination". Tu trouveras au final tes fichiers renommés dans "c:\destination".

Deux remarques concernant les fichiers TXT :
- si la première ligne contient une ou plusieurs virgules, seule la phrase précédant la première virgule sera prise en compte
- si la première ligne contient des caractères interdits par les règles sur les noms de fichier, le fichier ne sera pas traité.

Option Explicit

Sub Macro1()
    Dim I As Integer, NbFichiers As Integer
    Dim Dossier As String, TypeFichier As String
    Dim Origine() As String, Destination() As String
    Dim NomFichier As String, Ligne1 As String
    Dim NbErreurs As Integer
    Dim AppPath As String
    
    On Error GoTo GestErreur
    
    NbFichiers = 0
    Dossier = "C:\origine\"
    TypeFichier = "*.txt"
    AppPath = ThisWorkbook.Path & "\"
     
    NomFichier = Dir(Dossier & TypeFichier)
 
    Do While Len(NomFichier) > 0
        NbFichiers = NbFichiers + 1
        ReDim Preserve Origine(NbFichiers)
        Origine(NbFichiers) = Dossier & NomFichier
        NomFichier = Dir()
    Loop
    ReDim Destination(NbFichiers)
     
    If NbFichiers > 0 Then
        For I = 1 To UBound(Origine)
            Open Origine(I) For Input As #1
                Do
                    Input #1, Ligne1
                Loop Until Trim(Ligne1) <> ""
            Close #1
            Destination(I) = AppPath & Ligne1 & ".txt"
        Next
    End If
    
    For I = 1 To UBound(Origine)
        FileCopy Origine(I), Destination(I)
    Next I
    
    If NbErreurs > 0 Then MsgBox "Le programme a rencontré " & NbErreurs & " erreurs correspondant à des fichiers corrompus ou à des caractères interdits dans les noms de fichiers.", vbCritical + vbOKOnly, "Erreurs"
Exit Sub

GestErreur:
    NbErreurs = NbErreurs + 1
    'MsgBox Err.Number & vbLf & Err.Description
    Resume Next
End Sub

 

[ptibaz]

Re : renommer en masse

merci beaucoup pour ta réponse. ca va beaucoup m'aider !

malheureusement, je ne pourrai essayer que ce soir... je te tiendrai au courant.

autre chose qui n'a rien a voir:

As-tu une astuce pour modifier des nom de fichiers en masse dans un dossier?
je veux enlever "P -" dans tous mes fichiers

 

[Dormeur74]

Re : renommer en masse

C'est très facile à faire sous DOS. Si tu es sous XP, voici une solution.

Admettons que les fichiers à corriger soient dans le dossier c:\tetris

- Démarrer...Exécuter
- sur la ligne de commande "Ouvrir", taper cmd.exe
- une fois sous DOS, tu tapes :
CD \ [Entrée]
CD tetris [Entrée]
ren P?-*.* *.* [Entrée]

Tu fais très attention aux espaces : il y en a un après la commande ren (qui veut dire rename) et une autre entre *.* et *.*

 

[ptibaz]

Re : renommer en masse

j'ai pu tester la 1ere partie! nickel. les 135 fichiers renommés en 1 clic. Excellent!

merci beaucoup


par contre, sous MS dos ca marche pas.
soit il fait rien soit il dit fichier introuvable...

help !

 

[ptibaz]

Re : renommer en masse

pour MS DOS , laisse tomber je me suis debrouillé avec une macro!

est-ce qu'on peut refaire la 1ere étape (renommer les 135 fichiers) mais je veux remplacer les caracteres interdit pas des espaces.

C'est possible ca?

 

[Dormeur74]

Re : renommer en masse

On peut mettre des espaces à la place des caractères interdits, mais c'est un joli travail, car il va falloir les identifier. Très facile d'afficher le nom des fichiers qui posent problème. Il suffit de modifier la gestion d'erreur comme suit et de noter sur un papier ceux qui foirent :

GestErreur:
    NbErreurs = NbErreurs + 1
    MsgBox Origine(I)
    'MsgBox Err.Number & vbLf & Err.Description
    Resume Next

C'est toujours ça de gagné. Pour relancer une séquence de renommage, il suffit de détruire tous les fichiers .TXT du dossier dans lequel se trouve le fichier Excel et de relancer la macro.

 

[ptibaz]

Re : renommer en masse

merci beaucoup pour ton aide et merci au forum d'exister !

 

[Dormeur74]

Re : renommer en masse

De rien. Si ce forum n'existait pas, je n'aurais effectivement pas pu faire grand-chose pour toi.
A plus.