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
| Option Explicit
Public Typ As String
Sub TestListeFichiers()
Dim Cpt As Long, CptKill As Long, NBFich As Long
Dim Typ As String, Dossier As String, AncienNom As String, NewFich As String, NewName As String
Dim tiTableau As Variant
Dim Repertoire As FileDialog
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
If Repertoire.SelectedItems.Count > 0 Then
Dossier = Repertoire.SelectedItems(1)
Chargement.Show vbModeless
'On crée la liste des fichiers
'Ici pas possible de gérer la barre de progression
'Il faudrait modifier "un peu" ListFilesInFolder pour le gérer...
tiTableau = ListFilesInFolder(Dossier, ISF_Yes)
'On regarde s'il y a des fichiers a traiter
If UBound(tiTableau) > 0 Then
'On renomme les fichiers en affichant barre de progression
Renomme_Fichiers_ti tiTableau
End If
Unload Chargement
Else
MsgBox "Aucun Répertoire Sélectionné"
End If
End Sub
Function Renomme_Fichiers_ti(tiListing As Variant) As Long
Dim RowTab As Long
Dim RetourF As Integer
Dim CptModif As Integer, CptSupp As Integer
RowTab = 1
Do While RowTab < UBound(tiListing)
Chargement.pourcentage CInt(100 * (RowTab / UBound(tiListing)))
RetourF = Modif_Nom(tiListing(RowTab), Typ)
'On comptabilise
CptModif = CptModif + IIf(RetourF = 1, 1, 0)
CptSupp = CptSupp + IIf(RetourF = -1, 1, 0)
DoEvents
RowTab = RowTab + 1
Loop
'Il serait plus élégant d'utiliser le UserForm pour afficher le compte rendu, ça évite les MsgBox à répétition
'Tu pourrait par exemple modifier sa hauteur pour rendre visible des Label qui contiendraient les informations
If CptModif = 0 Then
MsgBox UBound(tiListing) & " fichiers traités" & Chr(10) & Chr(10) & "Aucun fichier renommé"
Else
MsgBox UBound(tiListing) & " fichiers traités, " & Chr(10) & Chr(10) & CptModif & IIf(CptModif = 1, " fichier renommé", " fichiers renommés")
If CptSupp = 0 Then
MsgBox "Aucun fichier supprimé"
Else
MsgBox CptSupp & IIf(CptSupp = 1, " fichier supprimé", " fichiers supprimés")
End If
End If
End Function
Function Modif_Nom(ByVal PathFichier As String, ByVal TypModif As String) As Integer
'On retournera
'0 - Pas de modification
'1 - Modification du Nom
'-1 - Suppression du fichier
Dim Cpt As Integer
Dim NbCar As Integer, NeedModif As Boolean
Dim NewName As String, NomFichier As String, NomDossier As String
Dim Pos1 As Integer, PosPoint As Integer
'Pas bon, il faut travailler uniquement avec le nom pas avec le chemin
'On extrait le nom et le dossier
NomFichier = Right(PathFichier, Len(PathFichier) - InStrRev(PathFichier, "\"))
NomDossier = Left(PathFichier, Len(PathFichier) - Len(NomFichier))
If TypModif = "Deb" Then
NbCar = 1
Do While NbCar <= Len(NomFichier) And Not NeedModif
If Not IsNumeric(Left(NomFichier, NbCar)) Then
NbCar = NbCar - 1
NeedModif = True
End If
Loop
If NeedModif Then NewName = Right(NomFichier, Len(NomFichier) - NbCar)
Else
NeedModif = InStr(2, NomFichier, "UTC)")
If NeedModif Then
Pos1 = InStrRev(NomFichier, "(")
PosPoint = InStrRev(NomFichier, ".")
NewName = Left(NomFichier, Pos1 - 1) & Right(NomFichier, Len(NomFichier) - PosPoint + 1)
End If
End If
'On regarde si le fihcier doit être traité
If NewName <> "" Then
'On lui rajoute son chemin d'accès
NewName = NomDossier & "\" & NewName
'Si fichier existe , delete
If Not FichierExiste(NewName) Then
Name PathFichier As NewName
Modif_Nom = 1
Else
Kill PathFichier
Modif_Nom = -1
End If
End If
End Function
Public Function FichierExiste(MonFichier As String)
If Len(Dir(MonFichier)) > 0 Then
FichierExiste = True
Else
FichierExiste = False
End If
End Function |
ProgressBar dans traitement fichiers
Répondre avec citation
Tutoriel :
Partager