script vbs lister fichiers *.prt dans sous repertoire

Version imprimable

Bonjour,

Je suis nouveau sur le forum,

Je souhaite écrire un script .vbs pour lister tous les fichiers *.prt a partir d'un répertoire et ses sous-répertoires,
et les inscrire dans vers fichier .txt. Si possible je souhaite extraire également la date de modification du fichier.

J'ai un début de script, mais j'ai une erreur d'exécution:
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 Set objFSO = CreateObject("Scripting.FileSystemObject") strSourceFolder = "G:\Cao\Espagne\_Intralink_project\165-mecanisme" strDestinationFile = "G:\Cao\Echange\tla\liste_prt_vbs.txt" Set objFile = objFSO.OpenTextFile(strDestinationFile, 8, True) Sub ParcourirDossier(strDossier) Set objFolder = objFSO.GetFolder(strDossier) For Each objFile In objFolder.Files If objFile.Name like "*.prt*" Then objFile.Copy strDestinationFile & vbCrLf, True End If Next For Each objSubFolder In objFolder.SubFolders ParcourirDossier objSubFolder.Path Next End Sub ParcourirDossier strSourceFolder objFile.Close Set objFile = Nothing Set objFolder = Nothing Set objFSO = Nothing Msgbox "Extraction Terminee"
Auriez vous une idée pourquoi au moment de la détection d'un fichier .prt, le Like mène a une erreur ?

Bienvenu sur DVP.

L'erreur provient du fait que tu utilises l'objet "objFile" pour copier dedans tous les fichiers à lister : copier et non écrire les noms de ceux-ci.
Voici une esquisse du code corrigé vite avec ouverture du fichier listant tous les fichiers du répertoire et ses sous-répertoires.

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
Set objFSO = CreateObject("Scripting.FileSystemObject") 
strSourceFolder = "G:\Cao\Espagne\_Intralink_project\165-mecanisme"
strDestinationFile = "G:\Cao\Echange\tla\liste_prt_vbs.txt"
 
Set objFile = objFSO.OpenTextFile(strDestinationFile, 8, True) ' fichier dans lequel on écrit
 
Sub ParcourirDossier(strDossier)
    Dim oFile ' relatif aux fichiers à liste
    Set objFolder = objFSO.GetFolder(strDossier)
 
    For Each oFile In objFolder.Files
        If LCase(Right(oFile.Name, 4)) = ".prt" Then
            objFile.WriteLine oFile.Path & vbTab & "Modif : " & oFile.DateLastModified
        End If
    Next
 
    For Each objSubFolder In objFolder.SubFolders
        ParcourirDossier objSubFolder.Path
    Next
End Sub
 
ParcourirDossier strSourceFolder
 
objFile.Close
 
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
 CreateObject("WScript.Shell").Run strDestinationFile, 1
Msgbox "Extraction Terminee"

11/12/2024, 08h46
Le Laitier

Bonjour l_autodidacte,

Je te remercie pour ta correction, cela m'a permis de comprendre, effectivement il me fallait spécifier un ofile.

J'ai une question supplémentaire si possible,

Dans mon code j'avais spécifié vouloir détecter les fichiers d'extension ".prt*",
Tu as corrigé par LCase(Right(oFile.Name, 4)) = ".prt"

Cela fonctionne, cependant c'est trop restrictif pour mon utilisation

J'ai besoin de détecter les fichiers ayant la syntaxe suivante:
m123456-123.prt
m123456-123.prt.1
m123456-123.prt.12
m123456-123.prt.123

Je ne sais pas si par un Left ou un Right cela est possible.

Merci par avance

Le mot réservé "Like" n'existe pas en VBS mais en VBA.

J'ai modifié le code pour tenir compte de l'extension principale et ce qui la 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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Option Explicit
Dim objFSO, strDestinationFile, strSourceFolder, objFile, objFolder, objSubFolder
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSourceFolder = "G:\Cao\Espagne\_Intralink_project\165-mecanisme"
strDestinationFile = "G:\Cao\Echange\tla\liste_prt_vbs.txt"
Set objFile = objFSO.OpenTextFile(strDestinationFile, 8, True) ' fichier dans lequel on écrit
 
'======================================= 
Sub ParcourirDossier(strDossier)
    Dim oFile ' relatif aux fichiers à lister
    Set objFolder = objFSO.GetFolder(strDossier)
 
    For Each oFile In objFolder.Files
       ' If LCase(Right(oFile.Name, 4)) = ".prt" Then
        If DefExtension(oFile.name) <> "" And InStr(oFile.Name, ".prt") > 0 Then
            objFile.WriteLine oFile.Path & vbTab & "Modif : " & oFile.DateLastModified
        End If
    Next
 
    For Each objSubFolder In objFolder.SubFolders
        ParcourirDossier objSubFolder.Path
    Next
End Sub
'======================================= 
ParcourirDossier strSourceFolder
 
objFile.Close
 
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
 CreateObject("WScript.Shell").Run strDestinationFile, 1
Msgbox "Extraction Terminee"
 
'==============================================
Function DefExtension(sFile)
   ' Fonction pour traiter l'extension de chaque fichier comportant ".prt"
   Dim pos, ext, Ret, npos
   pos = InStr(1, sFile, ".")
   npos = InStr(pos+3, sFile, ".")
   If npos = 0 Then
      Ext = Mid(sFile, pos+1, 3)
   Else 
      Ext = Mid(Sfile, pos+1)
   End If
   DefExtension = Ext
End Function

11/12/2024, 17h41
Le Laitier

C'est parfait, ca fonctionne avec ton script,

Merci à toi pour ton aide

Salut

:coucou: l_autodidacte

Une autre solution, un RegExp

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
'La fonction qui va bien
function ExpressionExiste(sFile,model)
	Dim RegularExpressioN
	Set RegularExpressioN = New RegExp
	RegularExpressioN.Pattern = model
	RegularExpressioN.IgnoreCase = True
	RegularExpressioN.Global = True
        ExpressionExiste = RegularExpressioN.Test(sFile)
	Set RegularExpressioN = Nothing
end function
 
 
 
'vérifications
'les 4 messages = True
msgbox  ExpressionExiste("m123456-123.prt",".prt")
msgbox  ExpressionExiste("m123456-123.prt.1",".prt")
msgbox  ExpressionExiste("m123456-123.prt.12",".prt")
msgbox  ExpressionExiste("m123456-123.prt.123",".prt")
 
'Les 2 messages = False
msgbox  ExpressionExiste("m123456-123.rpt.123",".prt")
msgbox  ExpressionExiste("",".prt")

pour ton code Le Laitier, boucle For Each,

Code:

1
2
3
        If ExpressionExiste(oFile.Name, ".prt") Then
            objFile.WriteLine oFile.Path & vbTab & "Modif : " & oFile.DateLastModified
        End If