Renommer des sous répertoires - erreur 800A0005
Bonjour,
Dans un dossier, j'ai un ensemble de sous répertoires et pour certains les noms sont écrit avec un mélange de majuscule et de minuscule.
Je voudrais passer tous les noms en majuscule.
Les répertoires existant déjà, je dois (?) passer par un nom intermédiaire pour les renomer, j'ajoute donc un .temp au nom d'orrigine (ligne 38).
Voici ou en est mon script, et je bloque sur la ligne 40 qui me retourne l'erreur 800A0005, argument ou appel de procédure incorrect ...
Pouvez vous me donner un coup de main? C'est certainement assez trivial, mais je ne trouve pas!
Merci d'avance
Code:
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
| option explicit
dim FSO, objShell
dim obFolder, obFolder2, obSubFolder, SubFolderName
dim SubFolderPath, UCaseName, NewFolderName, FD, FName
'Get Application object of the Windows shell.
Set objShell = WScript.CreateObject("Shell.Application")
'Ask the user to select a folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set obFolder = objShell.BrowseForFolder (&H0&, "Select the folder to process", &H1&) ' Var obFolder
'Keep obFolder for sub programms
Set obFolder2 = obFolder
If NOT obFolder IS Nothing Then
CheckRepSondage FSO, obFolder.Self.Path
MsgBox "Finished"
Else
MsgBox "Canceled"
End If
Sub CheckRepSondage (FSO, FolderPath)
Set obFolder = FSO.GetFolder(FolderPath)
For Each obSubFolder In FSO.GetFolder(obFolder).SubFolders
'Prend le chemin du rep
SubFolderPath = obSubFolder.Path
'Met le chemin en majuscules
UCaseName = UCase (SubFolderPath)
Set FD = FSO.GetFolder(obSubFolder)
'Ajoute .temp au chemin
FName = UCaseName & ".temp"
'Renome le répertoire
FD.Name = FName
Next
End Sub |
