So, assuming directory A has three Word files:
file1.doc
file2.doc
file3.doc
When I execute this VBScript I want to end up with a very simple/flat
HTML page with links to those three docs:
<html>
<head>
<title>Word Docs in this Folder</title>
</head>
<body>
<p><a href="file://../file1.doc">file1</a></p>
<p><a href="file://../file2.doc">file2</a></p>
<p><a href="file://../file3.doc">file3</a></p>
<body>
I am not sure if my directory notation is correct there, but I think
you get the point? I have struggled with it a bit and its beyond me.
Watch for word-wrap:
Option Explicit
'*
'* This VBS (Visual Basic Script) program does the following:
'* 1) Access the current folder for a list of ".doc" filenames.
'* 2) Generate and open a Web page with a link to each list item.
'*
Const cVBS = "WordDocs.vbs"
Const cHTM = "WordDocs.htm"
Const cDOC = "<p><a href='?' target='_blank'>?</p>"
'*
MsgBox "'" & cVBS & "' started."
Call Process()
MsgBox "'" & cVBS & "' finished."
Sub Process()
'*
'* Declare Variables
'*
Dim arrGFI(999)
Dim intGFI
intGFI = 0
Dim strGFI
Dim strOTF
strOTF = "var file = new Array;" & vbCrLf
Dim strSFN
strSFN = WScript.ScriptFullName
strSFN = Left(strSFN,InStrRev(strSFN,"\"))
'WScript.Echo strSFN
'*
'* Read Folder
'*
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objGFO
Set objGFO = objFSO.GetFolder(strSFN)
'WScript.Echo "'" & strSFN & "' has " & objGFO.Files.Count & " files."
Dim objGFI
Set objGFI = objGFO.Files
For Each strGFI in objGFI
If LCase(Right(strGFI.Name,4)) = ".doc" Then
arrGFI(intGFI) = strGFI.Name
intGFI = intGFI + 1
End If
Next
Set objGFI = Nothing
Set objGFO = Nothing
If intGFI = 0 Then
WScript.Echo "No MS-Word Docs in: " & vbCrLf & strSFN
Exit Sub
End If
'*
'* Build Web Page
'*
strOTF = "<html>" & vbCrLf
strOTF = strOTF & "<head>" & vbCrLf
strOTF = strOTF & "<title>MS-Word Docs in this Folder</title>" & vbCrLf
strOTF = strOTF & "</head>" & vbCrLf
strOTF = strOTF & "<body>" & vbCrLf
For intGFI = 0 To UBound(arrGFI)
If arrGFI(intGFI) <> "" Then
strOTF = strOTF & Replace(cDOC,"?",arrGFI(intGFI)) & vbCrLf
End If
Next
strOTF = strOTF & "</body>" & vbCrLf
strOTF = strOTF & "</html>" & vbCrLf
'*
'* Write Web Page
'*
Dim objOTF
Set objOTF = objFSO.OpenTextFile(strSFN & cHTM,2,true)
objOTF.WriteLine(strOTF)
objOTF.Close
Set objOTF = Nothing
Set objFSO = Nothing
'*
'* Open Web Page
'*
Dim objIEA
Set objIEA = CreateObject("InternetExplorer.Application")
objIEA.Visible = True
objIEA.Navigate strSFN & cHTM
While objIEA.Busy
Wend
End Sub
Oops, the following line should be removed from my original solution:
strOTF = "var file = new Array;" & vbCrLf
Here's a variation that allows the source folder to be selected and defaults
to the current folder if none is selected. Also, there are fewer string
concatenation statements to build the Web page.
Watch for word-wrap:
Option Explicit
'*
'* This VBS (Visual Basic Script) program does the following:
'* 1) Access the selected folder for a list of ".doc" filenames.
'* 2) Generate a Web page using this list of ".doc" filenames.
'*
Const cVBS = "WordDocx.vbs"
Const cHTM = "WordDocx.htm"
Const cBFF = "Select a folder"
Const cDOC = "<li><a href='??' target='_blank'>?"
'*
MsgBox "'" & cVBS & "' started."
Call Process()
MsgBox "'" & cVBS & "' finished."
Sub Process()
'*
'* Declare Variables
'*
Dim strDOC
Dim strFOL
Dim arrGFI(999)
Dim intGFI
intGFI = 0
Dim strGFI
Dim strOTF
Dim strSFN
strSFN = WScript.ScriptFullName
strSFN = Left(strSFN,InStrRev(strSFN,"\"))
'WScript.Echo strSFN
'*
'* Browse For Folder
'*
On Error Resume Next
Dim objSHL
Set objSHL = CreateObject("Shell.Application")
Dim objBFF
Set objBFF = objSHL.BrowseForFolder(&H0,cBFF,&H0031,&H0011)
strFOL = objBFF.ParentFolder.ParseName(objBFF.Title).Path
If Err.Number <> 0 Then strFOL = ""
Set objBFF = Nothing
Set objSHL = Nothing
'*
'* Current Folder Default
'*
If strFOL = "" Then strFOL = strSFN
'WScript.Echo strFOL
'*
'* Read Files in Folder
'*
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objGFO
Set objGFO = objFSO.GetFolder(strFOL)
'WScript.Echo "'" & strFOL & "' has " & objGFO.Files.Count & " files."
Dim objGFI
Set objGFI = objGFO.Files
For Each strGFI in objGFI
If LCase(Right(strGFI.Name,4)) = ".doc" Then
arrGFI(intGFI) = strGFI.Name
intGFI = intGFI + 1
End If
Next
Set objGFI = Nothing
Set objGFO = Nothing
If intGFI = 0 Then
WScript.Echo "No MS-Word Documents in: " & vbCrLf & strFOL
Exit Sub
End If
'*
'* Web Page Build
'*
strOTF = "<html>^<head>^<title>MS-Word Documents</title>^</head>^"
strOTF = strOTF & "<body>^<b>" & strFOL & "</b>^<ul>^"
For intGFI = 0 To UBound(arrGFI)
If arrGFI(intGFI) <> "" Then
If strFOL = strSFN Then
strDOC = Replace(cDOC,"??","?")
Else
strDOC = Replace(cDOC,"??",strFOL & "\?")
End If
strOTF = strOTF & Replace(strDOC,"?",arrGFI(intGFI)) & "^"
End If
Next
strOTF = strOTF & "</ul>^</body>^</html>" & vbCrLf
strOTF = Replace(strOTF,"^",vbCrLf)
'*
'* Web Page Write
'*
Dim objOTF
Set objOTF = objFSO.OpenTextFile(strSFN & cHTM,2,true)
objOTF.WriteLine(strOTF)
objOTF.Close
Set objOTF = Nothing
Set objFSO = Nothing
'*
'* Web Page in IE
Class Process
Private mstrExtension
Private mstrHTMName
Private mstrPath
Private mdicList
Private Sub Class_Initialize()
mstrExtension = "DOC"
mstrHTMName = "WordFileList"
Set mdicList = CreateObject("Scripting.Dictionary")
GetFileList
CreateHTML
End Sub
Private Sub Class_Terminate()
Set mdicList = Nothing
End Sub
Private Sub CreateHTML()
strTitle = "List of " & mstrExtension & " files as of " & Now()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile (mstrPath & "\" & mstrHTMName & ".htm", 2, True)
File.WriteLine("<html><head><title>" & strTitle & "</title></head><body>")
File.WriteLine(strTitle & "<hr><br>")
If mdicList.Count = 0 Then
File.WriteLine("No files available")
Else
For Each Item In mdicList.Items
strLink = "<a href='" & Item & "'>" & Item & "</a><br>"
File.WriteLine(strLink)
Next
End If
File.WriteLine("</body></html>")
Set File = Nothing
Set FSO = Nothing
End Sub
Private Sub GetFileList()
Set Sh = CreateObject("WScript.Shell")
mstrPath = Sh.CurrentDirectory
Set Sh = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(mstrPath)
Set Files = Folder.Files
If Files.Count <> 0 Then
For Each File In Files
If UCase(Right(File,3)) = mstrExtension Then
mdicList.Add mdicList.Count + 1,File
End If
Next
End If
Set Files = Nothing
Set Folder = Nothing
Set FSO = Nothing
End Sub
End Class
'from dlbjr
'Unambit from meager knowledge of inane others,engender uncharted sagacity.