1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
| dim tabl()
dim tablold()
redim tabl(1)
tabl(0)="lucas"
num=1
nbtot=0
nboct=0
nbssrep=0
Set fs = CreateObject("Scripting.FileSystemObject")
'choix du répertoire
nomrep=unescape("C:\Users\u475474\Desktop\Fiche de Maintenance")
'choix du mot recherché
mot_cherch=inputbox("Fiche faisant référence à",,"contre")
'Sécurité traiter le cas où nomrep est un disque ou un nom non valide
if not fs.folderexists(nomrep) or ucase(fs.getdrivename(nomrep))=ucase(replace(nomrep,"\","")) then
MsgBox "nom de répertoire non valide"
wscript.quit
end if
tabl(1)=nomrep
'créer le fichier texte et l'ouvrir en appending
fichresult="C:\Users\u475474\Desktop\liste_fichier.html"
Set nouv_fich = fs.OpenTextFile(fichresult, 2, true)
nouv_fich.close
Set nouv_fich = fs.OpenTextFile(fichresult, 8, false)
nouv_fich.writeline("<HTML><BODY>")
'boucler sur les niveaux jusqu'à ce qu'il n'y ait
'plus de sous répertoires dans le niveau
do while num>0 '------------------------------------
'recopie tabl
redim tablold(ubound(tabl))
for n=0 to ubound(tabl)
tablold(n)=tabl(n)
next
'réinitialiser tabl
redim tabl(0)
tabl(0)="lucas"
'explorer le ss répertoire
for n=1 to ubound(tablold)
expl(tablold(n)) 'ajoute ds le tableau tabl les ss rep de tablold(n)
next
loop '----------------------------------------------
nouv_fich.writeline("</BODY></HTML>")
nouv_fich.close
set nouv_fich=nothing
nboct2= int(fs.getfolder(nomrep).size/1024)
set fs=nothing
'afficher le résultat
'Msgbox nbtot & " fichiers pour " & int(nboct/1024) & " ko dans """ & nomrep & """ et ses " & nbssrep & " sous-répertoires (total " & nboct2 & " ko)",,nomrep
Set sh = WScript.CreateObject("WScript.Shell")
sh.run "explorer " & fichresult
set sh=nothing
'*************************************************************************
'*************************************************************************
'*************************************************************************
sub expl(nomfich)
'ajoute dans le tableau tabl() tous les sous répertoires de nomfich
'et ajoute dans le fichier nouv_fich les noms des fichiers et leurs caractéristiques
Set rep=fs.getFolder(nomfich)
num=ubound(tabl)
'parcourir les sous répertoires de nomfich
for each ssrep in rep.subfolders
num=num+1
redim preserve tabl(num)
tabl(num)= ssrep.path
nbssrep=nbssrep+1
next
'parcourir les fichiers de nomfich
for each fich in rep.files
nbtot=nbtot+1
nboct=nboct+fich.size
'chercher dans le fichier
'nouv_fich.writeline fich.path & " (" & int(fich.size/1024) & " ko, créé " & fich.DateCreated & ", acc " & fich.DateLastAccessed & ")"
if instr(lcase(fich.name),".txt")+instr(lcase(fich.name),".pdf")>0 then
Set fich_sce = fs.OpenTextFile(fich.path, 1, false)
txtlu=fich_sce.readall
fich_sce.close
txtlu=tt(txtlu)
pos=instr(lcase(txtlu),lcase(mot_cherch))
if pos>0 then
nouv_fich.writeline ("<BR><BR><A HREF='" & fich.path & "' target='_blank'>" & fich.name & "</A>")
do while pos>0
nbav=50
if pos-1<nbav then nbav=pos-1
nbapr=50
if len(txtlu)-pos-len(mot_cherch)+1<nbapr then nbapr=len(txtlu)-pos-len(mot_cherch)+1
txx= tt(mid(txtlu,pos-nbav,nbav)) & "<FONT COLOR='red'><B>" & tt(mid(txtlu,pos,len(mot_cherch))) & "</B></FONT>" & mid(txtlu,pos+len(mot_cherch),nbapr)
if nbav=50 then txx="..." & txx
if nbapr=50 then txx=txx & "..."
txx="<BR> " & txx
nouv_fich.writeline txx
txtlu=right(txtlu,len(txtlu)-pos+1-len(mot_cherch))
pos=instr(lcase(txtlu),lcase(mot_cherch))
loop
end if
end if
next
set rep=nothing
end sub
function tt(txte)
tt=txte
tt=replace(tt,"<","<")
tt=replace(tt,">",">")
end function |
Partager