Sujet Précédent Sujet Suivant

Création d'un rapport de recherche en VBS

Fermé
menojulien Messages postés 38 Date d'inscription jeudi 27 décembre 2007 Statut Membre Dernière intervention 22 août 2008 - 22 août 2008 à 09:57
 Utilisateur anonyme - 22 août 2008 à 14:17
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
A voir également:

1 réponse

Réponse 1 / 1
Utilisateur anonyme
22 août 2008 à 14:17
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
1

Discussions similaires

écrire un rapport de travail
asi -
REGINALD -

3 réponses