Discussion :

[erichissime]

Bonjour toutes et tous,
Je liste fichiers et répertoires récursivement, et quand un répertoire ou un fichier est inaccessible, le script s'arrête sur ce dossier malgré un On Error resume next.
Que faire pour passer aux dossiers ou fichiers suivants ?

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
On Error resume next
Dim FSO , objNewFile,oF
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNewFile = FSO.CreateTextFile ("C:\..\filelist.txt", True, True)'Unicode UTF-16
Set oF = FSO.GetFolder("C:\Users\..\Documents\")
 
WriteFilesAndFolders oF
 
Public Function WriteFilesAndFolders(Folder)
 
For Each Subfolder in Folder.SubFolders
objNewFile.WriteLine( SubFolder.Path )
WriteFilesAndFolders Subfolder
Next
For Each file in Folder.Files
objNewFile.WriteLine( file.Path )
Next
End Function

[l_autodidacte]

Tu peux adapter le code de ce POST pour lister les fichiers en plus des dossiers.

[erichissime]

salut et merci
je vais voir comment ajouter les fichiers

[erichissime]

voilà chose faite
merci
La MsgBox n'aime pas les accents
Bonne nuit

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
 Option Explicit 
 
 Const ForWriting = 2
 Dim oFSO, WS,objOut, objErr
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 
 Set objOut = oFSO.OpenTextFile("C:\Users\\\filelist.txt", ForWriting, True, True)
 Set objErr = oFSO.OpenTextFile("C:\Users\\\ErrLogFile.txt", ForWriting, True, True)
 ScanForFilesAndFolders oFSO.GetFolder("C:\Users\\Documents\")
 objOut.Close
 objErr.Close
 MsgBox "Recherche terminée."
 
Sub ScanForFilesAndFolders(oFolder)
    Dim oSubFolder, oFile
    On Error Resume Next    
        If Err.Number <> 0 Then
            objErr.WriteLine("Dossier [" & oFolder.Path & "] inaccessible")
            Err.Clear
        Else
            objOut.WriteLine(oFolder.Path)
        End If
    For Each oSubFolder In oFolder.SubFolders
        If Err.Number <> 0 Then
          objErr.WriteLine("Sous-dossier [" & oSubFolder.Path & "] inaccessible")
          Err.Clear
        Else
          ScanForFilesAndFolders oSubFolder
        End If
	Next
   For Each oFile In oFolder.Files
        If Err.Number <> 0 Then
          objErr.WriteLine("Fichier [" & oFile.Path & "] inaccessible")
          Err.Clear
        Else
	  objOut.WriteLine(oFile.Path)
	End If
    Next
End Sub

[l_autodidacte]

La MsgBox n'aime pas les accents

Si tu utilises Notepad++ pour taper ton code, c'est lui qui est la cause des lettres accentuées transformées en caractères bizarres.
Dans les paramètres, il faut pré-fixer le codage en ANSI.

On y parvient par le biais du menu Paramétrage => Préférences... Dans la liste de gauche choisir Nouveau document et tout à fait à gauche droite, cocher le bouton d'option ANSI ensuite le bouton Fermer.

Un petit Up pour le code modifié : Les lignes 31 à 38 devraient être déplacées juste après la ligne 21 (quoique en l'état actuel, le script fonctionne).

Je remplacerais la ligne 9 par ScanForFilesAndFolders oFSO.GetFolder(SelectFolder) et ainsi on n'a plus à modifier le script si on veut explorer un autre dossier :

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
Function SelectFolder()
Dim WSH, Item, lngFlag, Result, DialogTitle, drv, fso
 
    Set WSH = WScript.CreateObject("Shell.Application")
    lngFlag=BIF_RETURNONLYFSDIRS 
    DialogTitle="Sélection de dossier :(Pas de Poste de travail, Favoris réseau et/ou ses sous-éléments)"
    Set Item = WSH.BrowseForFolder(0,DialogTitle,lngFlag, "")
    If Item Is Nothing Then WScript.Quit 0
    Set WS = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    If LCase(Item.Title) = "poste de travail" Or LCase(Item.Title) = "favoris réseau" Then 
         MsgBox "Mauvais choix de répertoire [" & UCase(Item.Title) & "]" & VbCrLf & _
                 "Choisir un répertoire valide puis réessayer."
         WScript.Quit 0
    End If
    If LCase(Item.Title) = "mes documents" Or LCase(Item.Title) = "bureau"  Then
         Result = WS.ExpandEnvironmentStrings("%UserProfile%") & "\" & Item.Title
    ElseIf Is_Value(Item) Then
       Result = Item.Title
    ' A-t-on sélectionné la racine d'un lecteur ?
        If Right(Result, 2) = ":)" Then 
            ' Quand il s'agit de la racine d'un lecteur il faut tenir compte de son nom
            ' ( ou Label) qui se présente sous la forme NomLecteur(X:)
            Set drv = fso.GetDrive(Left(Right(Result, 3), 2))
            Result = drv.RootFolder
        ElseIf InStr(1, Result, ":") = 0 Then
            Result = Item.ParentFolder.ParseName(Item.Title).Path
        End If
    End If  
   SelectFolder = Result
End Function
'======================
Function Is_Value(obj)
    Dim stmp
    On Error Resume Next
    stmp = " " & obj
    Is_Value = (Err = 0)
    On Error GoTo 0
End Function

[erichissime]

Ok merci
Au fait le lien "La bible du vbscript" est mort
aurais-tu le fichier par ailleurs ?