Discussion :

[thomahh]

Bonjour,

J'ai dans mon fichier excel, une liste de nom de fichiers, que j'ai extrait d'un répertoire en colonne A. En colonne B, j'ai effectué un traitement de ces noms.

Maintenant, je voudrai utiliser les nouveaux noms de la colonne B, pour renommer directement les fichiers dans le répertoire.

J'ai une piste je pense :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub en_attendant3()
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set repertoire = fso.GetFolder("C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\")
Set fichiers = repertoire.Files
For Each f In fichiers
f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("a:a"), 0), 2).Value
Next
End Sub

J'ai réussi à faire marcher cette macro hier. Aujourd'hui plus moyen et je ne sais pas pourquoi, je n'ai rien changé !

Merci.

[Jean-Philippe André]

Salut,

j'aurais utilisé plus simplement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Name "ancienpath" as "nouveaupath"

[thomahh]

Merci mais , tu pourrais écrire le programme en entier parce que là, c'est un peu trop vague pour moi ?

[Jean-Philippe André]

Tu fais ta boucle, en remplace le "ancienpath" par les contenus de tes cellules de colonne A et "nouveaupath" par les contenus de tes cellules de colonne B.

On apprend mieux en cherchant par soi même

[thomahh]

Ok, j'ai utilisé ce prog :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub en_attendant4()
 
 
Dim AncienNom As String, NouveauNom As String
AncienNom = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("A1")
NouveauNom = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("B1")
Name AncienNom As NouveauNom
 
 
End Sub

Je ne comprends pas. Je l'ai lancé la première fois, ça à marché.

Du coup j'ai essayé de l'automatiser:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub en_attendant5()
 
 
    Dim LastRow As Long
    Dim j As Long
    LastRow = Range("A" & Rows.Count).End(xlDown).Row
 
    For j = 1 To LastRow
 
Dim AncienNom As String, NouveauNom As String
AncienNom = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("A" & j)
NouveauNom = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("B" & j)
Name AncienNom As NouveauNom
 
Next j
End Sub

ça n'a pas marché. Excel dit qu'il ne trouve pas le fichier erreur 53.

Du coup j'ai réessayé le 1er . Il ne marche plus non plus maintenant. Je ne comprends plus rien.

[Jean-Philippe André]

Pour pouvoir renommer un fichier, encore faut-il qu'il existe

Si tu renommes Pioupiou.xls en Piou.xls une fois, le fichier Pioupiou.xls n'existe plus.


Il faut auparavant faire un test d'existence par exemple.

[thomahh]

Ok,

J'ai réussi. Oui tu as raison , il manquait 1 seul nom de fichier dans la liste et du coup excel buggé dessus. Je l'ai remarqué et directment ça à marché.

Voici le programme final :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    Sheets(Nomfichtrait2).Select
    Dim LastRow2 As Long
    Dim k As Long
    LastRow2 = Range("A" & Rows.Count).End(xlDown).Row
 
    For k = 2 To LastRow2
 
    Dim AncienNom As String, NouveauNom As String
    AncienNom = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("A" & k)
    NouveauNom = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("B" & k)
    On Error Resume Next
    Name AncienNom As NouveauNom
    If Err = 75 Then Exit Sub
    Next k

Merci JPCHECK

[Invité]

J’espère que depuis le temps tu as trouvé ta réponse !
Je me baladais sur le forum quand j’ai vu ton annonce.
Voilà un petit code qui répond à ta question s’il ne t’ais plus utile il servira peut-être à quelqu’un ?
Maintenant il dispose de fonctions FSO qui peuvent t’intéresser !.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Sub ScanRang()
Dim Myrange As Range
Dim L As Long
Dim CelStart As Long
CelStart = 1 'S'il n'y a pas de cellule de titre de colonne.
CelStart = 2 'Exemple en A1 et B1 les titres sont [Fichier source] et [NewName]
 
Set Myrange = ActiveWorkbook.Sheets(3).Range("A1").CurrentRegion 'Instancie Myrange à toutes les cellules contigües à A1.
For L = CelStart To Myrange.Rows.Count
    Renommer_fichier_RD Myrange(L, 1), Myrange(L, 2) '(Ax.....Axn++) (Ax="c:\monRep\truc.txt) (Bx.....Bxn++) (Bx="truc.bof)
Next
End Sub
 
'Fonctions, utiles, de manipulation de fichiers et de répertoires ( Windows ).
'************************************************************************************
 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe_RD(Repertoires As String) As Boolean
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(Repertoires) Then Repertoires_Existe_RD = True
Set Fso = Nothing
End Function
 
'Crée un répertoire et ses sousrépertoires, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires_RD(NewRepertoires As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim T
Dim R As String
Dim I As Long
R = ""
T = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(T)
    If Trim("" & T(I)) <> "" Then
        R = R & Trim("" & T(I)) & "\"
        If Repertoires_Existe_RD(R) = False Then Fso.CreateFolder R
    End If
Next
Set Fso = Nothing
End Sub
 
'Copie un répertoire  et tout ce qu'il contient. vers une destination.
Public Sub Copie_Repertoires_RD(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFolder Source, Destination, True
Set Fso = Nothing
End Sub
 
'Déplace un répertoire et ses sousrépertoire d'un emplacement source vers une destination.
Public Sub Deplace_Repertoire_RD(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.MoveFolder Source, Destination
Set Fso = Nothing
End Sub
 
'Permet de supprimer et tout ce qu'il contient.
Public Sub Supprimer_Repertoire_RD(DelRepertoire As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.DeleteFolder DelRepertoire, True
Set Fso = Nothing
End Sub
 
'Vérifi  l'existance d'un fichier.
Public Function Existe_Fichier_RD(Source As String) As Boolean
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Existe_Fichier_RD = Fso.FileExists(Source)
Set Fso = Nothing
End Function
 
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier_RD(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Source, Destination, True
Set Fso = Nothing
End Sub
 
'Déplace un fichier d'un emplacement source vers une destination.
Public Sub Deplace_Fichier_RD(Source As String, Destination As String)
If Existe_Fichier_RD(Source) = False Then Exit Sub
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.MoveFile Source, Destination
Set Fso = Nothing
End Sub
 
'Supprime le fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier_RD(DelFichier As String)
Dim Fso As Object
If Existe_Fichier_RD(DelFichier) = False Then Exit Sub
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.DeleteFile DelFichier, True
Set Fso = Nothing
End Sub
'Renomer le fichiers dont le nom est précisé en argument par NewName.
 Public Sub Renommer_fichier_RD(Fichier As String, NewName As String)
 Dim Fso As New FileSystemObject
 If Existe_Fichier_RD(Fichier) = False Then Exit Sub
 Fso.GetFile(Fichier).Name = NewName
 End Sub
 
 'Si le fichier n'existe pas j'en fabrique un, avec son entête.
 Sub EnteteFichierRD(Fichier)
Dim TXT, Fso, NewFichier
 
TXT = "***********************************************************************************************************************************************************************************"
TXT = TXT & vbCrLf
TXT = TXT & "   Fichier de LOG"
TXT = TXT & vbCrLf
TXT = TXT & "   Date de création: " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Time) & ":" & Minute(Time) & vbCrLf
TXT = TXT & vbCrLf
TXT = TXT & "   " & Fichier
TXT = TXT & vbCrLf
TXT = TXT & "***********************************************************************************************************************************************************************************"
TXT = TXT & vbCrLf
TXT = TXT & vbCrLf
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = Fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write TXT
NewFichier.Close
 
 
Set NewFichier = Nothing
Set Fso = Nothing
End Sub
' Enregistre à la fin du fichier.
 Public Sub FichierLogRD(TXT, Fichier)
Dim FichierLog, Fso
 
 
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
If Fso.FileExists(Fichier) = False Then EnteteFichierRD Fichier
 
AppendTxtRD Fichier, TXT
 
Set Fso = Nothing
End Sub
Function AppendTxtRD(sFile, sText)
Dim Fso, NewFichier
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = Fso.OpenTextFile(sFile, 8)
 
NewFichier.Write sText
NewFichier.Close
 
Set NewFichier = Nothing
Set Fso = Nothing
 
End Function
'****************************************************************************************************************
'Fin