Création d'un rapport de recherche en VBS Fermé

Question

Bonjour,

J'ai un petit problème sur la création de mon rapport de recherche voici le code:

Option Explicit

Dim path_start
Dim Myfso, result
Set Myfso = CreateObject("Scripting.FileSystemObject")

path_start = "C:\Documents and Settings\JMENORET\Mes documents"

result = Find(path_start, "test.vbs")

MsgBox result

Function Find (strPath, strFileName)
	Dim MyDir, MyFile, MySubDir, fic
	Dim strResult, strResult1, strResult2, strResult3, strResult4, strResult5, strResult6 
	If strFileName = Empty Then Exit Function
	strFileName = Ucase(strFileName)

	Set MyDir = Myfso.GetFolder(strPath)

	For Each MyFile In MyDir.Files
		If Ucase(MyFile.Name) = strFileName Then strResult = strResult & strPath & "\" & MyFile.Name & vbCrLf
	Next

	For Each MySubDir In MyDir.SubFolders
		strResult = strResult & Find(strPath & "\" & MySubDir.Name, strFileName)
	Next
	
	Set fic = MyDir.Files
	For Each MyFile in fic
	
	Dim fdo, fichier
	
'+-------------Recherche des fichiers MP3-----------------+

if MyFile.type = "Fichier audio MP3 (mp3)" then 
strResult = strResult & vbcrlf & MyFile.path & chr(9)&  MyFile.Size &" Ko" & chr(9) & MyFile.type
Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
fichier.WriteLine(strResult)
fichier.Close
end if

'+-------------Recherche des fichiers JPEG-----------------+

if MyFile.type = "Image JPEG"  then 
strResult = strResult & vbcrlf & MyFile.path & chr(9)&  MyFile.Size &" Ko" & chr(9) & MyFile.type
Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
fichier.WriteLine(strResult)
fichier.Close
end if

'+-------------Recherche des fichiers WAVE-----------------+

if MyFile.type = "Son Wave"  then 
strResult = strResult & vbcrlf & MyFile.path & chr(9)&  MyFile.Size &" Ko" & chr(9) & MyFile.type
Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
fichier.WriteLine(strResult)
fichier.Close
end if

'+-------------Recherche des fichiers AVI-----------------+

if MyFile.type = "Clip vidéo"  then 
strResult = strResult & vbcrlf & MyFile.path & chr(9)&  MyFile.Size &" Ko" & chr(9) & MyFile.type
Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
fichier.WriteLine(strResult)
fichier.Close
end if

'+-------------Recherche des fichiers MPEG-----------------+

if MyFile.type = "Fichier vidéo (mpeg)"  then 
strResult5 = strResult & vbcrlf & MyFile.path & chr(9)&  MyFile.Size &" Ko" & chr(9) & MyFile.type
Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
fichier.WriteLine(strResult)
fichier.Close
end if

'+-------------Recherche des fichiers BMP-----------------+

if MyFile.type = "Image bitmap" then 
strResult = strResult & vbcrlf & MyFile.path & chr(9)&  MyFile.Size &" Ko" & chr(9) & MyFile.type
Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
fichier.WriteLine(strResult)
fichier.Close
end if
	
	
	
	Next

	Find = strResult  
End Function


Le problème c'est que dans mon rapport j'ai juste le dernier dossier scanné

Merci pour vos réponses

Utilisateur anonyme · Answer

Bonjour,

À cause de la récursivité de la fonction [ Find ], la création et la fermeture du fichier rapport
doivent se faire à l'extérieur de la fonction.

Suggestion de modification :


Option Explicit

    Dim path_start, Myfso, result

    Set Myfso = CreateObject("Scripting.FileSystemObject")
    path_start = "C:\Documents and Settings\JMENORET\Mes documents"
    ' Création du fichier rapport
    Set fichier = Myfso.CreateTextFile("c:\ rapport.xls", True)
    result = Find(path_start, "test.vbs", fichier)
    fichier.Close
    WScript.Echo result
    Set Myfso = Nothing

WScript.Quit (0)
'
'--------------------------------------------------------------------------------------------------------
'

Function Find(strPath, strFileName, fichier)

    Dim MyDir, MyFile, MySubDir, fic
    Dim strResult, strResult1, strResult2, strResult3
    Dim strResult4, strResult5, strResult6
    Dim fdo

    If Not (strFileName = Empty) Then
        strFileName = UCase(strFileName)
        Set MyDir = Myfso.GetFolder(strPath)
        For Each MyFile In MyDir.Files
            If UCase(MyFile.Name) = strFileName Then
                strResult = strResult & strPath & "\" & MyFile.Name & vbLf
            End If
        Next
        For Each MySubDir In MyDir.SubFolders
            strResult = strResult & Find(strPath & "\" & MySubDir.Name, strFileName)
        Next
        Set fic = MyDir.Files
        For Each MyFile In fic
            '+-------------Recherche des fichiers MP3-----------------+
            If (MyFile.Type = "Fichier audio MP3 (mp3)") Then
                strResult = strResult & vbLf & MyFile.Path & Chr(9) & MyFile.Size & " Ko" & Chr(9) & MyFile.Type
                fichier.WriteLine (strResult)
            End If
            '+-------------Recherche des fichiers JPEG-----------------+
            If (MyFile.Type = "Image JPEG") Then
                strResult = strResult & vbLf & MyFile.Path & Chr(9) & MyFile.Size & " Ko" & Chr(9) & MyFile.Type
                fichier.WriteLine (strResult)
            End If
            '+-------------Recherche des fichiers WAVE-----------------+
            If (MyFile.Type = "Son Wave") Then
                strResult = strResult & vbLf & MyFile.Path & Chr(9) & MyFile.Size & " Ko" & Chr(9) & MyFile.Type
                fichier.WriteLine (strResult)
            End If
            '+-------------Recherche des fichiers AVI-----------------+
            If (MyFile.Type = "Clip vidéo") Then
                strResult = strResult & vbLf & MyFile.Path & Chr(9) & MyFile.Size & " Ko" & Chr(9) & MyFile.Type
                fichier.WriteLine (strResult)
            End If
            '+-------------Recherche des fichiers MPEG-----------------+
            If (MyFile.Type = "Fichier vidéo (mpeg)") Then
                strResult5 = strResult & vbLf & MyFile.Path & Chr(9) & MyFile.Size & " Ko" & Chr(9) & MyFile.Type
                fichier.WriteLine (strResult)
            End If
            '+-------------Recherche des fichiers BMP-----------------+
            If (MyFile.Type = "Image bitmap") Then
                strResult = strResult & vbLf & MyFile.Path & Chr(9) & MyFile.Size & " Ko" & Chr(9) & MyFile.Type
                fichier.WriteLine (strResult)
            End If
        Next
        ' Fermeture du fichier rapport
        Find = strResult
    
        Set fichier = Nothing
        Set fic = Nothing
        Set MyDir = Nothing
    End If

End Function
'

Lupin

Création d'un rapport de recherche en VBS

1 réponse

Discussions similaires