'paramètres de la recherche
nomcherche=inputbox("nom du fichier recherché ?",,"*.xls")
repcherche=inputbox("répertoire exploré ?",,"c:\mes documents")
'recherche sous excel-----------------------------------------
'outils/macros/sécurité/éditeurs approuvés / faire confiance au projet visual basic
Set sh = WScript.CreateObject("WScript.Shell")
on error resume next
sh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\accessVBOM",1,"REG_DWORD"
on error goto 0
Set exl = WScript.CreateObject("excel.Application")
exl.Visible = false
set fichxl=exl.workbooks.add
Set mdle = fichxl.VBProject.VBComponents.Add(1)
mdle.CodeModule.InsertLines 1, "Sub rech()"
mdle.CodeModule.InsertLines 2, "With Application.FileSearch"
mdle.CodeModule.InsertLines 3, ".NewSearch"
mdle.CodeModule.InsertLines 4, ".LookIn = """ & repcherche & """"
mdle.CodeModule.InsertLines 5, ".Filename = """ & nomcherche & """"
mdle.CodeModule.InsertLines 6, ".SearchSubFolders = True"
mdle.CodeModule.InsertLines 7, ".Execute"
mdle.CodeModule.InsertLines 8, "For lin = 1 To .FoundFiles.Count"
mdle.CodeModule.InsertLines 9, "thisWorkbook.Sheets(1).Cells(lin, 2) = .FoundFiles(lin)"
mdle.CodeModule.InsertLines 10, "Next"
mdle.CodeModule.InsertLines 11, "ActiveWorkbook.Sheets(1).Cells(1, 1) = .FoundFiles.Count"
mdle.CodeModule.InsertLines 12, "End With"
mdle.CodeModule.InsertLines 13, "End Sub"
exl.Run "rech"
nbfich=fichxl.sheets(1).cells(1,1)
redim fich(nbfich-1)
for lin=1 to nbfich
fich(lin-1)= fichxl.sheets(1).cells(lin,2)
next
fichxl.close(false)
exl.quit
'affichage----------------------------------------------------
fichresult="c:\rien.html"
Set fs = CreateObject("Scripting.FileSystemObject")
Set nouv_fich = fs.OpenTextFile(fichresult, 2, true)
nouv_fich.write "
Résultat de la recherche"
nouv_fich.write "
de """ & nomcherche & """ dans """ & repcherche & """
(nombre de fichiers trouvés = " & nbfich & ")
"
for num = 0 to ubound(fich)
nouv_fich.write chr(10) & "
" & fich(num) & ""
next
nouv_fich.write chr(10) & ""
nouv_fich.close
sh.run "iexplore " & fichresult
'ménage--------------------------------------------------------
Set fichxl=nothing
set mdle=nothing
set exl=nothing
set sh=nothing
set fs=nothing
set nouv_fich=nothing