Renommer un fichier(ou dossier) sans le déplacer

Version imprimable

Nouvel élément qui peut intéresser quelques uns qui en auraient besoin; qu'en pensez-vous ?

La propriété Name d'un objet File ou Folder étant en Lecture / Ecriture, elle peut être utilisée pour renommer l'un ou l'autre objet sans avoir besoin de le déplacer. Le renommage étant instantané :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Option Explicit Dim fso, FL, FD Set fso = CreateObject("Scripting.FileSystemObject") Set FL = fso.GetFile("C:\Temp\Fichtest.txt") FL.Name="Fichier.bak" ' Nouveau nom du fichier Set FD = fso.GetFolder("C:\Temp") FD.Name = "Temp.Temp" 'Nouveau nom du dossier Set fso = Nothing Set FL = Nothing Set FD = Nothing
Juste une restriction : Le fichier ne doit pas être ouvert par quelque processus que ce soit, sinon on le ferme par l'instruction FL.Close, le dossier ne doit pas non plus être ouvert ou contenir des fichiers en cours d'utilisation.

Citation:

Envoyé par l_autodidacte

Nouvel élément qui peut intéresser quelques uns qui en auraient besoin; qu'en pensez-vous ?

La propriété Name d'un objet File ou Folder étant en Lecture / Ecriture, elle peut être utilisée pour renommer l'un ou l'autre objet sans avoir besoin de le déplacer. Le renommage étant instantané :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Dim fso, FL, FD
Set fso = CreateObject("Scripting.FileSystemObject")
 
Set FL = fso.GetFile("C:\Temp\Fichtest.txt")
     FL.Name="Fichier.bak" ' Nouveau nom du fichier
Set FD = fso.GetFolder("C:\Temp")
 
FD.Name = "Temp.Temp" 'Nouveau nom du dossier
Set fso = Nothing
Set FL = Nothing
Set FD = Nothing

Juste une restriction : Le fichier ne doit pas être ouvert par quelque processus que ce soit, sinon on le ferme par l'instruction FL.Close, le dossier ne doit pas non plus être ouvert ou contenir des fichiers en cours d'utilisation.

Désolé de déterrer ce topic de 2012 8O
Mais je propose celui-là :

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
Option Explicit
Dim File,MyRootFolder,RootFolder
MyRootFolder = Browse4Folder
Call Scan4File(MyRootFolder)
MsgBox "Script fini !"  & vbcr & "Tous les fichiers du dossier sont passés !" & vbcr & "Merci à hackoofr",VbInformation,"Opération finie !"
'**************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Please select a folder in order to scan into it and its subfolders to rename files"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,0,0)
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
End Function
'****************************************************************************
Function Scan4File(Folder)
    Dim fso,objFolder,arrSubfolders,FileName
    Dim Tab,SubFolder,aFile,partfic
    Dim oShell,iRet
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    Set arrSubfolders = objFolder.SubFolders
    For Each FileName in objFolder.Files
        Set aFile = fso.GetFile(FileName)
        Tab = Split(FileName,".")
        Set oShell = WScript.CreateObject("WScript.Shell")
            partfic = split(FileName,".")
            Set oShell = WScript.CreateObject("WScript.Shell")
             iRet = InputBox ("Comment voulez-vous renommer le fichier?", "Renommer fichier",FileName)        
                       partfic = split(FileName,".")
                       Set oShell = WScript.CreateObject("WScript.Shell")
                       aFile.Move iRet
                       oShell.Popup "Le fichier : " & vbcr & FileName & vbcr & vbcr & " Est devenu : " & vbcr & iRet,3,"Information",vbOKOnly+64          
Next
End Function

Il passe tous les fichiers d'un dossier dans l'inputbox (même si les fichiers sont ouverts)
Il n'a pas besoin de répertoire/nom de fichier dans le script pour faire sa fonction

Le seul "bug" est qu'il y a une erreur si vous cliquez sur Annuler dans l'inputbox

Le but de mon post était de montrer qu'il est possible de renommer un fichier/ou dossier sans le déplacer comme indiqué par le lien vers la FAQ VBScript.

L'utilisateur peut s'en servir pour construire une Fonction ou Procédure de renommage d'un ou de plusieurs éléments.

En revenant à la fonction Scan4File, il y a dedans 3 fois création d'un objet oShell(et cela pour chaque fichier) alors qu'une seule suffit amplement.
Il s'agit de Set oShell = WScript.CreateObject("WScript.Shell").

L'objet oShell créé reste valable jusqu'à la fin si on ne l'a pas détruit.

Pour le bug invoqué, il suffit de mettre une condition et tout rentre dans l'ordre.
Je propose alors une retouche de la fonction Scan4File qui peut être indifféremment une Sub (puisqu'elle ne retourne pas de résultat) comme suit :
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 Sub Scan4File(Folder) Dim fso,objFolder,arrSubfolders,FileName Dim Tab,SubFolder,aFile ',partfic Dim oShell,iRet Set fso = CreateObject("Scripting.FileSystemObject") Set objFolder = fso.GetFolder(Folder) Set arrSubfolders = objFolder.SubFolders Set oShell = WScript.CreateObject("WScript.Shell") ' déplacement ici de la création de l'objet oShell For Each FileName in objFolder.Files Set aFile = fso.GetFile(FileName) Tab = Split(FileName,".") 'Set oShell = WScript.CreateObject("WScript.Shell") ' partfic = split(FileName,".") ' Set oShell = WScript.CreateObject("WScript.Shell") iRet = InputBox ("Comment voulez-vous renommer le fichier?", "Renommer fichier", FileName) If iRet <> "" Then 'Condition ajoutée ' partfic = split(FileName,".") ' Set oShell = WScript.CreateObject("WScript.Shell") aFile.Move iRet oShell.Popup "Le fichier : " & vbcr & FileName & vbcr & vbcr & " est devenu : " & vbcr & iRet,3,"Information",vbOKOnly+64 Else ' Sinon on passe au suivant On Error Resume Next ' Ou Exit Sub mais là on arrête le traitement End If Next End Sub
[EDIT] Il y a aussi partfic qui n'est utilisé nulle part, donc à supprimer ou commenter.

Amélioration du script !!!

Une amélioration de ton script pourrait être la suivante avec un comptage des fichiers renommés dans le cas où on aurait appuyé sur Annuler dans l'InputBox d'une part et les fichiers qu'on laisse sans changement d'autre part. C-à-d le cas où on appuie sur Oui sans modifier le nom ou l'extension du fichier, le nombre de fichiers renommés ne change pas.

Si le dossier choisi est vide, le script propose la recherche d'un autre dossier :

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
    Dim MyRootFolder, n, Tot, Msg
    MyRootFolder = Browse4Folder
    Call Scan4File(MyRootFolder, Tot, n)
    If n = 1 Then
       Msg = "Script fini !"  & vbcr & "Il y a " & n & " fichier parmis " & Tot & " qui a été renommé !" 
    ElseIf n > 1 Then
       Msg = "Script fini !"  & vbcr & "Il y a " & n & " fichiers parmis " & Tot & " qui ont été renommés !" 
    ElseIf n = 0 Then
       Msg  = "Aucun fichier parmis " & Tot & " n'a été renommé !"
    End If   
    MsgBox Msg, vbInformation, "Opération fini !"
'**************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Choisir un dossier en vue de renommer ses fichiers"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, Message, 1, 0)
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
End Function
'****************************************************************************
Sub Scan4File(Folder, Tot, n)
    Dim fso,objFolder,arrFiles,FileName, iCount
    Dim SubFolder,aFile 
    Dim oShell,iRet
    n = 0 : Tot = 0
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(Folder)
    Set arrFiles = objFolder.Files
    If arrFiles.Count = 0 Then 
       If MsgBox("Le Dossier " & Folder & " ne contient pas de fichiers." & vbCrLf & _ 
           "Voulez-vous traiter un autre dossier ?",vbYesNo,"Autre dossier à traiter ?") = vbYes Then
          Set objFolder = fso.GetFolder(Browse4Folder)
          Set arrFiles = objFolder.Files
          On Error GoTo 0
       Else 
           Exit Sub
       End If
    End If
    iCount = 0
    Set oShell = WScript.CreateObject("WScript.Shell") 
    For Each FileName in arrFiles 
        Set aFile = fso.GetFile(FileName)
            iRet = InputBox ("Comment voulez-vous renommer le fichier ?", "Renommer fichiers",FileName) 
            If iRet <> "" Then         
                 If UCase(iRet) <> UCase(FileName) Then
                    aFile.Move iRet
                    iCount = iCount + 1
                    oShell.Popup "Le fichier : " & vbcr & FileName & vbcr & vbcr & " est devenu : " & vbcr & iRet, 3, "Information", vbOKOnly+64          
                 End If
            Else  
               On Error Resume Next 
            End If
    Next
    n=iCount
    Tot = arrFiles.Count
End Sub