Discussion :

[klef63]

Bonjour,

Je voulait tout d'abord remercier "Hackoofr" pour l'aide qu'il m'a apporter sur ma précédente demande, hélas pour mon projet j'ai encore des soucis.
Je débute et n'y connais absolument rien en vbs, je me documente petit à petit...

J'ai un problème dans une purge de fichiers sur un serveur avec des données utilisateur.
En fait, certains noms de fichiers ont des noms avec des caractères incorrects, ce qui fait planter mon script de purge.
Ce sont les caratères spéciaux qui ne sont pas censés faire partie d'un nom de fichier :
\ / : * ? " < > |

J'aimerais créer un vbs qui remplace ces caractères par un underscore _
En gros définir un dossier, avec une fonction récursive qui traite tous les fichiers dans ce dossier ainsi que les fichiers dans les sous-dossiers.
Avec journalisation dans un fichier log.txt par exemple avec heure et date de début et de fin, ainsi que les détails des fichiers qui ont été modifiés.

Ces caractères s'affichent sous la forme d'un petit carré dans l'explorateur, car ils ne sont pas reconnus, mais si je fait un copier/coller du nom de fichier dans un fichier texte, je vois de quel caractère il s'agit.
Peut être faut il faire une recherche hexadécimale sur les noms de fichiers ??



Merci d'avance pour votre aide !

Edit :

Je viens de me rendre compte également que ces caractères foireux peuvent être aussi un genre de flèche qui va vers la droite, il n'y a même pas de correspondance dans la table Ascii (lors du collage dans un fichier txt)
Notepad++ ou ultraedit32 affichent un point d'intérogation, pour montrer qu'il ne connaissent pas le caractère.
Ces fichiers corrompus sont tous des favoris Internet, je n'ai pas possibilité de les supprimés...

Peut être peut ont faire dans le script en sorte que tous ce qui ne ressemble pas à un caractère classique de la table ascii (exclus les caractères spéciaux interdits), doit être remplacé par un _

Je crois que ça va être vraiment compliqué

[pc75]

Bonjour,

Pour explorer les dossiers et les sous-dossiers, tu trouveras ce qu'il te faut en faisant une recherche dans ce forum.

Pour les caractères spéciaux dans les noms de fichiers, tu pourras faire un truc comme ça :

Code :

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

1
2
3
4
5
6
7
8
 
for i = 1 to len(NomDeFichier)
   if asc(mid(NomDeFichier), i, 1) >= 65 and asc(mid(NomDeFichier), i, 1) <= 122 then
      NouveauNom = NouveauNom & "_"
   else
      NouveauNom = NouveauNom & mid(NomDeFichier), i, 1)
   end if
next

[klef63]

Merci,

Je pense que ca devrait donner à peu près ça, mais ca ne marche pas "fin d'instruction attendue"
Je comprend pas du tout pourquoi, merci de m'éclairer !

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
'Repertoire ou sont stockes les fichiers 
DossierDestination = "D:\DossierTest" 
 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "LogFile_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject")
if not fso.fileExists(LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des fichiers modifiés à cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des fichiers modifiés à cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
 
'On verifie que le repertoire de destination existe 
If (myName = Winrep = fso.FolderExists(DossierDestination)) = False Then 
    Erreur = MsgBox("Le dossier de destination est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date systeme 
DateSysteme = Date 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
 'On remplace les caractères spéciaux par un underscore
 For Each File In Folder.Files
 For i = 1 to len(NomDeFichier)
   if asc(mid(NomDeFichier), i, 1) >= 65 and asc(mid(NomDeFichier), i, 1) <= 122 then
      NouveauNom = NouveauNom & "_"
   else
      NouveauNom = NouveauNom & mid(NomDeFichier), i, 1)
	  OutPut.WriteLine File.Path
   end if
next
End Sub

[pc75]

Re,

1 - Il manque un next
2 - Je me suis planté dans la syntaxe

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
For Each NomDeFichier In Folder.Files
 For i = 1 to len(NomDeFichier)
   if asc(mid(NomDeFichier, i, 1)) >= 65 and asc(mid(NomDeFichier, i, 1)) <= 122 then
      NouveauNom = NouveauNom & "_"
   else
      NouveauNom = NouveauNom & mid(NomDeFichier, i, 1)
	  OutPut.WriteLine NomDeFichier.Path
   end if
 next
next

[klef63]

Ca marche toujours pas, cette fois ci ca plante sur la dernière ligne :

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
'Repertoire ou sont stockes les fichiers 
DossierDestination = "D:\test_del_anciens_fichiers" 
 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "LogFile_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject")
if not fso.fileExists(LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des fichiers modifiés à cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des fichiers modifiés à cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
 
'On verifie que le repertoire de destination existe 
If (myName = Winrep = fso.FolderExists(DossierDestination)) = False Then 
    Erreur = MsgBox("Le dossier de destination est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date systeme 
DateSysteme = Date 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
 'On remplace les caractères spéciaux par un underscore
For Each NomDeFichier In Folder.Files
 For i = 1 to len(NomDeFichier)
   if asc(mid(NomDeFichier, i, 1)) >= 65 and asc(mid(NomDeFichier, i, 1)) <= 122 then
      NouveauNom = NouveauNom & "_"
   else
      NouveauNom = NouveauNom & mid(NomDeFichier, i, 1)
	  OutPut.WriteLine File.Path
   end if
 next
next
End Sub

Sinon le reste du code à l'air bon ?

[Daffy13]

Je débute aussi en VBS, ce que je comprend pas dans ton code, c'est la fermeture d'un SUB a la fin ... mais y'a pas d'ouverture ...

Peut être ça ton problème ...

[klef63]

Pas bête du tout j'avais pas vu, je l'ai enlevé mais maintenant j'ai une autre erreur sur la ligne "Set SubFolder = Folder.SubFolders" >> Objet requis

J'ai vraiment du mal... j'ai essayer pleins de trucs mais rien y fait.

[Daffy13]

Ok,

Déjà il faudrait rajouter en début de code :

Code :

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

Option Explicit

Ca permet de voir des erreurs de variables non définit.

Quand je vois

Code :

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

Set SubFolder = Folder.SubFolders

Cela veut dire que tu assigne a la variable SubFolder une valeur. Seulement, cette valeur n'est décrite nulle part dans ton script, je sais pas si je m'explique bien ...

[klef63]

Bon en gros je comprend pas tout, la fonction explicit ne marche pas.

Voici le code une nouvelle fois, j'ai rajouté une ligne.
En fait pour le Subfolder je comprend pas quoi mettre s'il faut déclarer une variable.
Je suis trop mauvais et trop fatigué pour comprendre.

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
'Repertoire ou sont stockes les fichiers 
DossierDestination = "D:\test_del_anciens_fichiers" 
 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "LogFile_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject")
if not fso.fileExists(LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des fichiers modifiés à cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des fichiers modifiés à cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
 
'On verifie que le repertoire de destination existe 
If (myName = Winrep = fso.FolderExists(DossierDestination)) = False Then 
    Erreur = MsgBox("Le dossier de destination est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date systeme 
DateSysteme = Date 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
Set Folder = fso.Getfolder(FolderPath)
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
 'On remplace les caractères spéciaux par un underscore
For Each NomDeFichier In Folder.Files
 For i = 1 to len(NomDeFichier)
   if asc(mid(NomDeFichier, i, 1)) >= 65 and asc(mid(NomDeFichier, i, 1)) <= 122 then
      NouveauNom = NouveauNom & "_"
   else
      NouveauNom = NouveauNom & mid(NomDeFichier, i, 1)
	  OutPut.WriteLine File.Path
   end if
 next
next

Et ca marche toujours pas...

[l_autodidacte]

Salut

Bien sûr que ça ne marche pas puisque tu exclus les caractères normaux(alphabet) dans ton code

if asc(mid(NomDeFichier, i, 1)) >= 65 and asc(mid(NomDeFichier, i, 1)) <= 122 then
NouveauNom = NouveauNom & "_"

alors qu'on doit avoir

Code :

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

1
2
if asc(mid(NomDeFichier, i, 1)) < 65 and asc(mid(NomDeFichier, i, 1)) > 122 then
      NouveauNom = NouveauNom & "_"

D'autre part, tu dois réinitialiser la variable NouveauNom à chaque itération sinon tous les noms vont être concaténés.

Tu utilises une fonction ou procédure Clean, Que représente-t-elle ? quel en est le code ?

J'ajouterais autre chose : File.Path n'est défini nulle part dans ton code. A la place il te faut mettre NouveauNom juste avant le dernier Next

Code :

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

1
2
3
4
........
Next
OutPut.WriteLine NouveauNom
Next

[klef63]

En fait ça risque d'être plus compliqué que ça comme script, la plage de caractères que vous m'avez indiquée est trop restreinte et il y a des risque qu'un trop grand nombre de fichiers modifiés.
Je vais voir avec un collègue ce qu'on peut faire, et vous tiens au courant de l'avancée.
Merci

[klef63]

J'ai trouvé une solution sur le site technet Microsoft :
http://gallery.technet.microsoft.com...9-a0c0719c9238

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
' Created By Walter Touceda 
' This script will remove all non-English characters in  
' all File Names in a specific folder (WINDOWS ONLY) 
' It assumes a format like C:\temp\my folder\file name.ext 
' 
On Error Resume Next 
i = 0 
' Ask for full path 
Do While i = 0 
    strAnswer = InputBox _ 
        ("Please enter the path (e.g.: C:\temp\)","Clean File Names") 
    If strAnswer = "" Then 
        MsgBox "You must enter a path. Press OK to finish" 
 Wscript.Quit 
    Else 
 If objFSO.FolderExists(strAnswer) Then 
         Exit Do 
 Else 
  MsgBox "This folder does not exist: " & strAnswer 
 End If 
    End If 
Loop 
 
' In MyPath don't forget to include the last \ 
If Right(strAnswer,1) = "\" then 
 MyPath = strAnswer 
Else 
 MyPath = strAnswer + "\" 
End If 
 
Set objFSO = CreateObject("Scripting.FileSystemObject")       
' Create FSO 
Set objFolder = objFSO.GetFolder(MyPath)  
 
'Process every file in the Folder 
For Each objItem in objFolder.Files 
 Wscript.Echo "--------------------------" 
 Wscript.Echo "Checking: " & objItem.Name 
 ' Preserve Original Filename 
 OriName = objItem.Name 
 ' Start with blank new FileName 
 FileName = "" 
 
 ' Check Original FileName character by character 
 For i = 1 To Len(OriName) 
  MyCh = Mid(OriName, i, 1) 
         If (MyCh >= " ") And (MyCh <= "~") Then 
   ' Build FileName with English Characters Only 
   FileName = FileName + MyCh 
  Else 
   ' This is a non-English character, ignore it 
   ' Don't include it in new FileName 
  End if 
 Next 
 OriName = MyPath & OriName 
 FileName = MyPath & Filename 
 If OriName = Filename then 
  ' Filename was all-English, no need to rename 
 Else 
  ' Remove spaces at the end of the FileName 
  ' Filename includes the extension, so do not include it 
  Aux = Len(FileName) - 4 
  Filename = Trim(Left(FileName,Aux)) 
  ' Keep same extension 
  FileName = Filename + Right(OriName,4) 
  Wscript.Echo "Renaming file : " & OriName 
  Aux = objFSO.MoveFile(OriName, FileName) 
  If Aux = 0 Then 
   Wscript.Echo "Renamed to    : " & FileName 
  Else 
   Wscript.Echo "** Failed to rename: " & OriName 
  End If 
 End If 
Next 
 
' Clean memory and quit 
Set OriName = Nothing 
Set FileName = Nothing 
Set MyCh = Nothing 
Set Aux = Nothing 
Set objFSO = Nothing 
Set objFolder = Nothing 
Set strAnswer = Nothing 
Wscrip.Quit

Il manque juste la fonction récursive, sinon c'est impeccable !