Hi , I post this script for searching files by name and it list the results in a HTML file. My problem is when i choose * in the InputBox ,means the search must be in all drives it will not work but when i use a specific letter of drive to search like C:\ or D:\ it works for me !!! so please i want just someone here tell me why this is happning and what's wrong in this code ??
Thank You !
Thank You !
Code:
Dim fso, OutFile, sDrv, sFName, sReport, sFile, sTitle ,strHTML
sTitle = "Recherche des Fichiers Par leurs Noms"
Set fso = CreateObject("Scripting.FileSystemObject")
OutFile = "C:\Recherche.html"
If fso.FileExists(OutFile)
Then fso.DeleteFile(OutFile)
Set sReport = fso.OpenTextFile(OutFile, 8, True)
sDrv = InputBox("Entrez la lettre du lecteur à la recherche (lettre seulement)" & vbcrlf&_
"ou bien " & vbcrlf & "(Saisissez * pour rechercher toutes les lettres de lecteur local)", sTitle)
If sDrv = "" Then WScript.Quit
sFName = InputBox ("Entrez le nom du fichier à rechercher (sans extension)", sTitle)
If sFName = "" Then WScript.Quit
strHTML="<html><body text=white><style type='text/css'>"&_
"a:link {color: #F19105;}"&_"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
strHTML=strHTML &"<center><h2><B> <font color=Red>[COUNT] </font>Fichiers Trouvés dont le Nom est <font color=red>"""& sFName &""" </font> sur le lecteur <font color=red>"& UCase(sDrv) & ":</B></font></h2></center>"&_
"<center><body bgcolor=#1234568><table border='3' cellpadding='1' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'></center>" & _
"<td><center><strong>Chemin :</strong></center></td>"&_
"<td><center><strong>Date de Création :</strong></center></td>"& _
"<td><center><strong>Date de Modification :</strong></center></td>"&_
"<td><center><strong>Taille :</strong></center></td>"&_
"<td><center><strong>Attributs:</strong></center></td>"
If sDrv = "*" Then
Dim Drive
For Each Drive in fso.Drives
If Drive.DriveType = 2 Then
GetResults Drive, sFName
End If
Next
Else
GetResults sDrv & ":", sFName
End If
strHTML = Replace(strHTML, "[COUNT]", Results) sReport.WriteLine strHTML &"</table></body></html>"
sReport.Close
Set sReport = Nothing
Dim f, ra, Results
Set f = fso.OpenTextFile(OutFile)
On Error Resume Next
ra = f.ReadAll
If Err Then Results = 0
End If
On Error GoTo 0
f.Close
Set f = Nothing
Set fso = Nothing If Results > 0 Then
Wscript.CreateObject("WScript.Shell").Run OutFile
Else
MsgBox "Désolé il n'y a Aucune Instance pour le fichier " & chr(34) & sFName & chr(34) & " Sur " & Ucase(sDrv) & ":",48, sTitle
End If
Sub GetResults(drv, fname)
Dim sWQL, oFile, sAttrib,sFilePath,size
sWQL = "select * from cim_datafile where Drive='" & _
drv & "' AND FileName = '" & fname & "'" Results = 0
For Each oFile In GetObject("winmgmts:").execquery(sWQL)
Results = Results + 1
sFile = oFile.Name
Set f = fso.GetFile(sFile)
Size = Round(FormatNumber(f.Size, 0)/1024,2) & " Ko"
sFilePath = f.Path
If oFile.Archive Then sAttrib = "Archive "
If oFile.Compressed Then sAttrib = sAttrib & " Compressé "
If oFile.Encrypted Then sAttrib = sAttrib & " Crypté "
If oFile.Hidden Then sAttrib = sAttrib & " Caché "
If oFile.System Then sAttrib = sAttrib & " Système "
If oFile.Readable Then sAttrib = sAttrib & " Lecture "
If oFile.Writeable Then sAttrib = sAttrib & " Ecriture "
strHTML=strHTML & "<tr><td><a target=_Blank href='" & sFilePath & "'>" & _
sFilePath & "</a></td><td><center>" & f.DateCreated & "</center></td>" & _
"<td><center>" & f.DateLastModified & "</center></td><td><center>"& Size & "</center></td>"&_
"<td><center>" & sAttrib & "</center></td></tr>"
Next
End Sub