' ---------------------------------------------------------- ' Script d'exportation des favoris (noms et URL) ' y compris dans les sous-répertoires ' dans un fichier HTML ' ' Jean-Claude BELLAMY - © 2006 ' ---------------------------------------------------------- Dim prec ForReading=1 Const SW_HIDE=0 Const SW_SHOWNORMAL=1 Dim shell, fldrs, fso, ts Set shell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") FileResult=GetPath() & "listfav.html" Set ts=fso.CreateTextFile(FileResult, true,true) ' Récupération du chemin du dossier "Favoris" Set fldrs = Shell.SpecialFolders fav=fldrs("Favorites") ColorBack="""#FFFFD8""" ts.Writeline "" & "Favoris" & "" ts.Writeline "" & Titre & "" ts.Writeline "" ts.WriteLine "

Dossier des favoris : " & fav & "

" indfav=InstrRev(fav,"\")+1 prec="" ts.writeline "" ts.close prompt="La liste des favoris a été stockée dans" & VBCRLF & _ "le fichier " & FileResult & VBCRLF & _ "Appuyer sur :" & VBCRLF & _ " OUI pour l'ouvrir avec le navigateur" & VBCRLF & _ " NON pour l'ouvrir avec le bloc-notes" rep=MsgBox(prompt, vbYesNo + vbQuestion, "Liste des favoris") If rep=vbYes Then commande=chr(34) & FileResult & chr(34) else commande=shell.ExpandEnvironmentStrings("%windir%\notepad.exe " & chr(34) & FileResult & chr(34)) end if shell.Run commande, SW_SHOWNORMAL, false wscript.quit '---------------------------------------------------- ' Sous-programme récursif d'exploration des dossiers sub explorefolder(namefolder,curfolder) dim f,collfolders,collfiles Set f = fso.GetFolder(namefolder) ' Collection des fichiers et sous-dossiers du dossier courant Set collfolders= f.SubFolders Set collfiles = f.Files subname=mid(namefolder,indfav) ts.writeline "
  • " & curfolder & "
  • " end sub '-------------------------------------------------------------------- ' Fonction de récupération du répertoire courant Function GetPath() Dim path path = WScript.ScriptFullName GetPath = Left(path, InStrRev(path, "\")) End Function