Recherche recursive de fichiers avec caracteres généric [VBS - RESOLU] - VB/VBA/VBS - Programmation
Marsh Posté le 22-11-2005 à 17:05:44
Pour ceux que ca interesse voici ce que j'ai fait en modifiant un code trouvé sur le net.
' Test program for ListDir function.
' Lists file names using wildcards.
' Author: Christian d'Heureuse (www.source-code.biz)
' License: GNU/LGPL (http://www.gnu.org/licenses/lgpl.html)
'Modified by Wilfrid Burel on the 22nd November 2005 in order to be recursive
' By default the function Listdir is Recursive. If you don't want the recursivity put something as second argument
' ex : cscript ListDir "D:\temp\*.exe" 0 will scan folder temp for exe files
' ex : cscript ListDir "D:\temp" will scan folder temp and subfolders for all files
Option Explicit
Dim a ' WB
Dim n: n = 0 ' WB
Dim Recursivity ' WB
Main
Sub Main
Dim Path
Select Case WScript.Arguments.Count
Case 0: Path = "*.*" ' list current directory
Case 1: Path = WScript.Arguments(0) ' WB
Case 2: Path = WScript.Arguments(0) : Recursivity = WScript.Arguments(1) ' WB
Case Else: WScript.Echo "Invalid number of arguments.": Exit Sub
End Select
Select Case Recursivity ' WB
Case "" : Recursivity=True ' WB
Case Else : Recursivity=False ' WB
End Select ' WB
ReDim a(10) ' WB
a = ListDir(Path)
If UBound(a) = -1 then
WScript.Echo "No files found."
Exit Sub
End If
Dim FileName
For Each FileName In a
WScript.Echo FileName 'Put here what you want to be done
Next
End Sub
' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
' Author: Christian d'Heureuse (www.source-code.biz)
' Modified by Wilfrid Burel on the 22nd November 2005 in order to be recursive : modification commented and signed
Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject" )
If Path = "" then Path = "*.*"
Dim Parent, Filter
if fso.FolderExists(Path) then ' Path is a directory
Parent = Path
Filter = "*"
Else
Parent = fso.GetParentFolderName(Path)
If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else Parent = "."
Filter = fso.GetFileName(Path)
If Filter = "" Then Filter = "*"
End If
'ReDim a(10) quote by WB
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
'Implementation of recursivity WB
If Recursivity then
Dim SubFolder ' WB
If Folder.SubFolders.Count <> 0 Then 'WB
For Each SubFolder In Folder.SubFolders ' WB
ListDir(SubFolder&"\" & Filter) ' WB
Next ' WB
End If ' WB
End If
Set Files = Folder.Files
For Each File In Files
If CompareFileName(File.Name,Filter) Then
If n > UBound(a) Then ReDim Preserve a(n*2)
a(n) = File.Path
n = n + 1
End If
Next
ReDim Preserve a(n-1)
ListDir = a
End Function
Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case "*"
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case "?"
If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function
Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function
Marsh Posté le 22-11-2005 à 11:15:58
Bonjour
Ce que je souhaiterais faire c'est :
rechercher des fichiers as*.url ou *. url (par exemple) dans toute l'arborescence de "C:\Documents and settings" .
J'avoue ne pas reussir a faire ce script donc si quelqu'un y arrive je suis preneur.
L'ideal serait de retourner la liste dans un "tableau" ou quelque chose de ce genre. Toute proposition est bienvenue.
J'en ai besoin pour trouver tout ces fichiers afin de modifier leur contenu (remplacement de chaine), mais modifier ca j'y arrive.
Merci de votre aide.
OS : W2K SP4 sans .NET
Message édité par orlith le 22-11-2005 à 17:05:08