mistux Site Admin
Joined: 25 Jun 2004 Posts: 1042 Location: South Bend, Indiana USA
|
Posted: Mon Sep 18, 2006 8:26 am Post subject: Directory Listing to HTML File |
|
|
Code: |
'*****************
'* Directory Listing Script to HTML
'* From a Design by Richard Harrison - richard.harrison@oldham.ac.uk
'* Code taken from Donovan Kuln & Dale Ross postings on the
'* newsgroup microsoft.public.scripting.wsh as well as example
'* code from microsofts samples
'*
'* Last Updated - Aug. 12, 1998
'*
'* Note
'* 1) Needs a blank file by the name of DirList.txt in c:\
'* This is becuase the script will error if it cannot
'* find it first time around. I dont know enough about
'* scripting to know why you have to do this.
'*
'* 2) Note #1 is no longer the case. The program prompts the
'* user for a starting folder for the listing and then puts
'* the dirlist.txt file in that folder. If it exists, its
'* overwritten, if not, created.
'*
'* This code added by Fred Coleman fredkc@local.net
'*
'* Sep. 13, 1998
'*
'* 3) This version called Dirlist_H2.vbs writes the dir list
'* to an HTML file: Dirlist.htm in the chosen sub/folder.
'*
'* This code cobbled by Fred Coleman fredkc@local.net
'* With apologies to Richard Harrison.
'* Sep. 15, 1998
'*
'*****************
Option Explicit
' Create the FileSystem Object
dim oFileSys, fh1, fh2, fh3, fh4, fh5
dim Dir, filcnt
Dim Wedone
Dim strDirDoneTxt
Dim strMsgTitle
dim strInput, strRunit
Dim IExec, strTarget
' Change this file name if you
' want to use a different one.
strTarget = "\DirList.htm"
strInput= InputBox("Please Enter a starting folder", "User Input","")
dir = strInput
Set oFileSys = CreateObject("Scripting.FileSystemObject")
set fh1=oFileSys.createTextFile(strInput & strTarget)
fh1.WriteLine("<HTML>")
fh1.WriteLine("<HEAD><TITLE>Listing of: " & strInput & "</TITLE></HEAD>")
fh1.WriteLine("<BODY text=004080 bgcolor=FFFFFF>")
fh1.WriteLine("<P>")
fh1.WriteLine("<center><h2>")
fh1.WriteLine("Directory Listing of: " & Dir)
fh1.WriteLine("</h2></center><HR><font size=3>")
fh1.WriteLine("<P> ")
fh1.close
strDirDoneTxt ="HTML Listing Finished"
strMsgTitle = "HTML Directory Lister."
'kick start it!
GetDir dir
' Remove next comment if you want an Alert Box when its finished.
' Wedone = MsgBox(strDirDoneTxt, vbOKOnly + vbInformation, strMsgTitle )
'-------
sub GetDir(dir)
dim fh2,fh3,oFolder,oFolders,oFiles,item,Item2
set oFolder=oFileSys.GetFolder(dir)
set oFolders=oFolder.SubFolders
set oFiles=oFolder.Files
' get all sub-folders in this folder
For each item in oFolders
'go to each one
GetDir(item)
Next
set fh4=oFileSys.openTextFile(strInput & strTarget,8)
fh4.WriteLine("<B>" & "<a href=" & chr(34) & ofolder & chr(34) & ">" & ofolder & "</a></b><BR>")
fh4.close
filcnt = filcnt +1
item2=0
For each item2 in oFiles
set fh3=oFileSys.openTextFile(strInput & strTarget,8)
fh3.WriteLine(Dir & "\" & item2.Name & "<BR>")
fh3.close
filcnt = filcnt +1
next
end sub
set fh5=oFileSys.openTextFile(strInput & strTarget,8)
fh5.WriteLine("<HR><font size=+1><b>" & filcnt-1 & " items in the folder <font color=804040>" & strInput & "</font> and its sub-folders.</font></b><BR>")
fh5.WriteLine("<BODY><HTML>")
fh5.close
' This section opens the file in IE after were done.
' If you dont want that, comment out the next four lines.
Set IExec = CreateObject("InternetExplorer.Application")
strRunit = strInput & strTarget
IExec.navigate strRunit
IExec.visible=1
|
|
|