Discussion :

[Le Laitier]

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 :

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
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 ?

[l_autodidacte]

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 :

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
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"

[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

[l_autodidacte]

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 :

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
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

[Le Laitier]

C'est parfait, ca fonctionne avec ton script,

Merci à toi pour ton aide

[ProgElecT]

Salut

l_autodidacte

Une autre solution, un RegExp

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
'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 :

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

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