Création d'un rapport de recherche en VBS
menojulien
Messages postés
38
Statut
Membre
-
Utilisateur anonyme -
Utilisateur anonyme -
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
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:
- Création d'un rapport de recherche en VBS
- Creation de site web - Guide
- Vbs windows - Accueil - Optimisation
- Creation compte gmail - Guide
- Creation de compte google - Guide
- Recherche automatique des chaînes ne fonctionne pas - Guide
1 réponse
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 :
Lupin
À 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
