renommer fichiers en vracRésolu

Question

Bonjour à toutes et tous, 

Depuis Access 2002, en VBA, je voudrais renommer tous les fichiers se trouvant dans un répertoire déterminé. Le nouveau nom devrait comporter une chaîne de caractères + le nom du fichier original.
exemple en ajoutant AA. au nom
C:\monfolder\
145.xls      devriendrait    AA.145.xls
A4789.txt   =         AA.A4789.txt

Qui pourrait m'aider ?
Merci d'avance.

cs_wape · Accepted Answer

Bonjour,

Une autre possibilité, sans utiliser FSO :

sRep = "C:\MonFolder"
sFic = Dir(sRep & "*.*")


Do Until sFic = ""
   Name sRep & sFic As sRep & "AA." & sFic
   sFic = Dir()
Loop

wape

cs_JMO · Answer

Bonjour,

Rien de plus simple avec fso.

jean-marc

Option Explicit
Dim Path  : Path = "d:	est1"
Dim fso, Dossiers, fichier, fichiers
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(Path)
Set fichiers = Dossiers.Files



'pour chaque fichier de mon objet fichiers de mon objet fso...)
For Each fichier in fichiers
'MsgBox fichier.Name
fso.MoveFile fichier, Replace(fichier, fichier.Name, "AA_" & fichier.Name)
Next
Set Dossiers = Nothing
Set fichiers = Nothing
Set fso = Nothing
MsgBox "Rename des fichiers effectués !!!", vbInformation

jeanluc065 · Answer

Bonjour, 

j'ai essayé ta solution mais j'obtiens un message d'erreur 
erreur d'exécution : 70     Permission refusée et le débogage s'arrête sur 

fso.MoveFile fichier, Replace(fichier, fichier.Name, "AA_" & fichier.Name)


Merci pour ta collaboration.


JL

cs_JMO · Answer

Re ,

Mon exemple n'est pas en vb6. 
Il doit falloir référencer fso et rajouter des "dim As ......"
L'exemple de wape est en vb6.
Par contre, il n'est conseillé de nommer des fichiers avec des "."

jean-marc

jeanluc065 · Answer

Re bonjour à vous 2,

les 2 solutions fonctionnent bien.
Je pense que c'est parce que j'avais un C:\aa\ et que je souhaitais renommer mes fichiers avec AA     aussi ?
J'ai testé avec un autre répertoire et c'est magnifique.
Un grand merci à vous deux.
JL

cs_JMO · Answer

Re,

Pense à valider la proposition de "wape" puisqu'elle est en vb6.
Tu peux éventuellement rajouté les SubFolders.
(Par contre, il n'est pas conseillé de nommer des fichiers avec des ".")

jean-marc

jeanluc065 · Answer

Re-bonjour, 

Tout baigne mais qu'elle serait la synthaxe pour éviter de renommer un fichier qui l'a déjà été donc dans ce cas, ne pas renommer les fichiers commençant par AA ?
merci

cs_JMO · Answer

Re,

'pour chaque fichier de mon objet fichiers de mon objet fso...:)
For Each fichier in fichiers
'MsgBox fichier.Name


If Left(fichier.Name, 3) = "AA_" Then
   Msgbox fichier.Name,,"Ce fichier a déjà été renommé !"
   Else
   fso.MoveFile fichier, Replace(fichier, fichier.Name, "AA_" & fichier.Name)
   End I
Next

jean-marc

jeanluc065 · Answer

Magnifique, et voilà pour tout le monde la solution complète de jean-marc

Option Explicit
Private Sub Commande11_Click()
Dim Path: Path = "C:\aa\Clients"
Dim fso, Dossiers, fichier, fichiers
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(Path)
Set fichiers = Dossiers.Files


'pour chaque fichier de mon objet fichiers de mon objet fso...)
For Each fichier In fichiers
'MsgBox fichier.Name


If Left(fichier.Name, 3) = "BA_" Then
   MsgBox fichier.Name, , "Ce fichier a déjà été renommé !"
   Else
   fso.MoveFile fichier, Replace(fichier, fichier.Name, "BA_" & fichier.Name)
   End If




Next
Set Dossiers = Nothing
Set fichiers = Nothing
Set fso = Nothing
MsgBox "Rename des fichiers effectués !!!", vbInformation


End Sub

cs_JMO · Answer

Re,

Suite à ton mail, je viens d'écrire, en vbs, et tester le script ci-dessous.
C'est l'une des premières fois que je me lance dans Excel, via vbs.
J'aurai pû, tjrs en vbs, créer et exécuter directement une macro
qui modifie le nom de la Feuil1.
Dans mon exemple, le nom de la 1ère feuille est renommé au nom du fichier, sans son extension.
Il y a surement plus simple en vb6 (ou même en vbs).

jean-marc

'Il s'agirait de renommer des feuilles de fichiers excel
'qui ont tous la même présentation mais les noms de feuilles 
'sont un peu différents ( ils commencent tous par la même chaîne 
'de caractères plus ( par exemple dans le fichier 12.xls la feuille xy12 
'et dans le fichier xy14.xls la feuille xy14.xls ) et il faudrait remommer '
'ces feuilles en xy tout simplement) xy étant déterminé une fois pour toute.



Dim Path     :Path  = "d:	est1" 



MsgBox ShowFolderList(Path),vbMessage,"Modification fichiers Excel"



Function ShowFolderList(strPath) 
Dim fso      :  Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers :  Set Dossiers = fso.GetFolder(path)
Dim fichiers :  Set fichiers = Dossiers.Files


Dim fichier, f, strListe 


For Each fichier in fichiers 
    Set f = fso.GetFile(fichier)
    If fso.GetExtensionName(fichier) = "xls" Then
       Dim objExcel, objClasseur
       Set objExcel=CreateObject("Excel.Application")
       Set objClasseur=objExcel.WorkBooks.Open(fichier)


       objExcel.DisplayAlerts=False 'enlève l'alerte 
       objExcel.Application.Visible=False


      'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 avant modification"
      objClasseur.Sheets(1).Name = Replace(f.Name, ".xls","")
      'WScript.Sleep "500"
      'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"


      objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
      objExcel.ActiveWorkbook.Saved=True 'sauvegarde true=oui false=non
      'objExcel.DisplayAlerts=True 'remet l'alerte 
      'objExcel.Application.Visible=True 'remet la visibilité
      objExcel.ActiveWorkbook.Close 'Fermeture d'Excel


      strListe = strListe &vbCrLf& f.Name
      Set objExcel = Nothing
      Set objClasseur = Nothing
   End If
Next
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing
ShowFolderList = "Fichiers xls dont le nom de la Feuil1 a été modifié" &vbCrLf&vbCrLf& strListe 


End Function

jeanluc065 · Answer

re re re bonjour,

merci pour ton dévouement, 
voici ce que j'obtiens :
erreur de compilation :
erreur de synthaxe sur 
strListe = strListe &vbCrLf& f.Name
sorry

jeanluc065 · Answer

précision, 
Plus simplement, pour plus de facilité, renommer la feuille xy 12 et la feuille xy14 de mes 2 classeurs différents comme ceci " JL "
merci
jl

cs_JMO · Answer

Bonjour à tous et Re... à Jean-Luc,

Je teste en vbs, donc en vb6, il y a quelques modifs à effectuer.
Si le pb est sur strliste, il suffit de l'enlever !!!
jean-marc

Option Explicit
Dim Path     :Path  = "d:	est1" 
Call ModifExcelNameFeuil1 (Path) 
MsgBox "script terminé !",,"Modif du nom de la Feuil1 de fichiers excel"


Function ModifExcelNameFeuil1(strPath) 
Dim fso      :  Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers :  Set Dossiers = fso.GetFolder(path)
Dim fichiers :  Set fichiers = Dossiers.Files


Dim fichier, f ', strListe 


For Each fichier in fichiers 
    Set f = fso.GetFile(fichier)
    If fso.GetExtensionName(fichier) = "xls" Then
       Dim objExcel, objClasseur
       Set objExcel=CreateObject("Excel.Application")
       Set objClasseur=objExcel.WorkBooks.Open(fichier)


       objExcel.DisplayAlerts=False 'enlève l'alerte 
       objExcel.Application.Visible=False


      MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 avant modification"
      objClasseur.Sheets(1).Name = Replace(f.Name, ".xls","")
      'WScript.Sleep "500"
      MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"


      objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
      objExcel.ActiveWorkbook.Saved=True 'sauvegarde true=oui false=non
      'objExcel.DisplayAlerts=True 'remet l'alerte 
      'objExcel.Application.Visible=True 'remet la visibilité
      objExcel.ActiveWorkbook.Close 'Fermeture d'Excel


      Set objExcel = Nothing
      Set objClasseur = Nothing
   End If
Next
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing
End Function

cs_JMO · Answer

Re,

      MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 avant modification"
      objClasseur.Sheets(1).Name = Replace(f.Name, ".xls","")
      MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"

Tu mets ce que tu veux dans objClasseur.Sheets(1).Name 

objClasseur.Sheets(1).Name  = "TOTO"
ou
objClasseur.Sheets(1).Name  = Date
...

jean-marc

jeanluc065 · Answer

Jean-Marc, 
Je viens d'essayer, voici le plantage en gras et tel que j'ai écrit.

Private Sub Étiquette14_Click()
Dim Path: Path = "a:\aa2\Prox"


MsgBox ShowFolderList(Path), vbMessage, "Modification fichiers Excel"
End Sub
*****************************************
Function ShowFolderList(strPath)
Dim fso:        Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers:   Set Dossiers = fso.GetFolder(Path)
Dim fichiers:   Set fichiers = Dossiers.Files

cs_JMO · Answer

Re,

Essaie avec Function ShowFolderList(Path)
At home, pas de pb, le nom des Feuil1 est bien modifié.

jeanluc065 · Answer

rererere,


çà commence à fonctionner, 


1- les a feuilles se renomment bien,


2- j'ai le message ok


3- j'ai un message d'erreur ,
 erreur d'exécution 5
argument ou appel de procédure incorrect.
et le débogade pointe ( en gras )


Function ShowFolderList(Path)
Dim fso:        Set fso =  CreateObject("Scripting.FileSystemObject")
Dim Dossiers:    Set Dossiers = fso.GetFolder(Path )
Dim fichiers:   Set fichiers  = Dossiers.Files

mais çà commence à bien fonctionner.

jeanluc065 · Answer

MERCIIII Jean-Marc, tout fonctione il y avait un str qui traînait devant  Path.
Voici donc toute le code complet pour renommer toutes les feuilles 3 et 4  en feuilles commandes et factures   de tous les fichiers xls contenus dans C:\clients\vins

Private Sub Étiquette14_Click()
Dim Path: Path = "C:\clients\vins"


MsgBox ShowFolderList(Path), vbMessage, "Modification fichiers Excel"
Call ShowFolderList(Path)
End Sub




Function ShowFolderList(Path)
Dim fso:        Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers:   Set Dossiers = fso.GetFolder(Path)
Dim fichiers:   Set fichiers = Dossiers.Files


Dim fichier, f, strListe


For Each fichier In fichiers
    Set f = fso.GetFile(fichier)
    If fso.GetExtensionName(fichier) = "xls" Then
       Dim objExcel, objClasseur
       Set objExcel = CreateObject("Excel.Application")
       Set objClasseur = objExcel.Workbooks.Open(fichier)


       objExcel.DisplayAlerts = False 'enlève l'alerte
       objExcel.Application.Visible = False


      'MsgBox objClasseur.Sheets(1).Name,,"Nom des feuilles  avant modification"
      objClasseur.Sheets(3).Name = "commandes"
      objClasseur.Sheets(4).Name = "factures"
      'WScript.Sleep "500"
      'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"


      objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
      objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
      'objExcel.DisplayAlerts=True 'remet l'alerte
      'objExcel.Application.Visible=True 'remet la visibilité
      objExcel.ActiveWorkbook.Close 'Fermeture d'Excel


     
      Set objExcel = Nothing
      Set objClasseur = Nothing
   End If
Next
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing


End Function

cs_JMO · Answer

Bonjour à tous....

Salut Jean-Luc
Pour répondre à ton mail (Folder et SubFolder).

jean-marc
Si d'autres questions, vaut mieux ouvrir un nouveau topic, puisque
celui-ci est clos.

Option Explicit



Dim path(1)
Path(0) = "d:	est1_voitures"
Path(1) = "d:	est1_camions"



Dim Separateur(1)
Separateur(0) = "AA_"
Separateur(1) = "BB_"



Dim i
For i = 0 To UBound(path)
    'MsgBox Path(i) &vbCrLf& Separateur(i)
    Call RenameFiles(Path(i),Separateur(i))
Next



MsgBox "Rename des fichiers effectués !!!", vbInformation



Function RenameFiles(Path,Separateur)
Dim Fso, MyFile, MyFolder, MySubFolder
Set Fso = CreateObject("Scripting.FileSystemObject")
Set MyFolder = Fso.GetFolder(Path)



'pour chaque fichier de mon objet fichiers de mon objet fso...:)
For Each MyFile in MyFolder.Files
    'MsgBox MyFile.Name &vbCrLf& Separateur,,"Vérification MyFile"
    If Left(MyFile.Name, 3) = Separateur Then
       'MsgBox MyFile.Name,,"Ce fichier a déjà été renommé !"
    Else
       'MsgBox MyFile &vbCrLf& MyFile.Name &vbCrLf& Separateur
       Fso.MoveFile MyFile, Replace(MyFile, MyFile.Name, Separateur & MyFile.Name)
    End If
Next
'pour chaque fichier des sous-répertoires
For Each MySubFolder In MyFolder.SubFolders
    'MsgBox MySubFolder &vbCrLf& MySubFolder.Name &vbCrLf& Separateur &vbCrLf& Path & "" & MySubFolder.Name,,"Vérification MySubFolder"
    Call RenameFiles(Path & "" & MySubFolder.Name, Separateur)
Next



Set MyFolder = Nothing
Set Fso = Nothing
End Function

jeanluc065 · Answer

Bonjour ,

Merci Jean-Marc  pour ta collaboration.
JL

Renommer fichiers en vrac

20 réponses

Votre réponse

Discussions similaires