HTA: Wait for event before continuing script

GomezAddamz · Sep 15, 2014

Hey forum! I'm looking for a way to make a VBS script inside an HTA wait for input before continuing execution. Specifically, I have a dynamically populated list box from which the user will need to make a selection and then click a button before the script can continue. I know I can use the onClick event to start a process, but I do not know how to make a running process wait for an event before continuing (presuming it can even be done). This is, of course, part of a larger project, but the following code demonstrates the task-at-hand. Is there a way to send the selection back to the Window_onLoad sub, or am I barking up the wrong tree?

Code:

<html>
<head>
<title>Tester</title>

<HTA:APPLICATION 
     ID="TesterHTA"
     APPLICATIONNAME="Tester"
     SINGLEINSTANCE="yes"
>
</head>

<SCRIPT Language="VBScript">
Option Explicit

Dim FSO, objOption, testFile, testStr

Sub Window_onLoad
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set testFile = FSO.OpenTextFile("C:\test.txt",1)
	Do Until testFile.AtEndOfStream
		testStr = testFile.ReadLine
		Set objOption = document.createElement("OPTION")
		objOption.Text = testStr
		objOption.value = objOption.Text
		options.Add(objOption)
	Loop
	'Wait for user to click 'Submit' then run add'l code.
	testFile.Close
End Sub

</SCRIPT>

<body>
<select id="options" size="4">
</select>
<br>
<button>Submit</button>
</body>
</html>

VulcanJedi · Sep 16, 2014

This seems to not make sense, or barking up wrong tree. If you already want them to hit submit, just add to the submit box code.

crackoo · Sep 16, 2014

Hi !
Can you explain more your idea because i don't understand at all you aim ???

wchull · Sep 16, 2014

Like VulcanJedi I'm not sure what your wanting. With HTA's subroutines provide the control you're wanting automatically. If your just imputing data and you're not validating the data then you tab to the next field and the HTA will simply for you to input data. Using specific subroutines you can perform routines when you enter the field or exit the field and you can change what field has focus by telling the HTA what field or button has the focus. Pushing a button is intended for some sort of action after you have entered all of your data but the button will not execute the onClick sub associated with the button name until you press the button. Here's a sample HTA that may help you understand how things work in an HTA. The HTA below allows you to input data into textbox fields and when the data is entered it writes the data to a text file and then displays the users external IP address if they are behind a router. If the data file exists the next time the HTA is executed it will read the file and load the previously stored data into the HTA fields and skip all input and place focus on the start button. There's also an simple encryption routine and some other cool stuff as a demo of what you can do with an HTA. Hope this helps you. Enjoy!

<HEAD>
<TITLE>Track My External IP Address</TITLE>
</HEAD>
<BODY BGCOLOR="#ffffff">

<FORM NAME="TrackMyIPForm">
<HTA:APPLICATION
ID = "TrackMyIP"
APPLICATIONNAME = "Track My External IP Address"
BORDER = "thick"
CAPTION = "yes"
SHOWINTASKBAR = "yes"
SINGLEINSTANCE = "yes"
SYSMENU = "yes"
WINDOWSTATE = "Normal"
SCROLL = "No"
SCROLLFLAT = "No"
VERSION = "1.0"
INNERBORDER = "yes"
SELECTION = "no"
MAXIMIZEBUTTON = "Yes"
MINIMIZEBUTTON = "Yes"
NAVIGABLE = "yes"
CONTEXTMENU = "yes"
BORDERSTYLE = "sunken"
>
<center><Table Border =2>
<Caption><Font color="#0000FF" face="arial" size="4pt"><B>Track My External IP Address</Font></B></Caption>
<Caption><Font color="#0000FF" face="arial" size="1pt"><B>Please make appropriate changes before pressing <U>START</U></Font></B>
<Caption><Font color="#0000FF" face="arial" size="1pt"><B>Note: Passwords are hidden and encrypted.</Font></B>
<TR><Center>
<TD><Font face="arial" size="2pt">Sender First Name:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="TEXT" SIZE=30 NAME="SenderFirstName"></TD>
</Center></TR>
<TR>
<TD><Font face="arial" size="2pt">Sender Last Name:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="TEXT" SIZE=30 NAME="SenderLastName"></TD>
</TR>
<TR>
<TD><Font face="arial" size="2pt">Send From Address:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="TEXT" SIZE=30 NAME="SendFromAddr"></TD>
</TR>
<TR>
<TD><Font face="arial" size="2pt">Send To Address:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="TEXT" SIZE=30 NAME="SendToAddr"></TD>
</TR>
<TR>
<TD><Font face="arial" size="2pt">SMTP Server:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="TEXT" Size=30 Name="SMTPServer"></TD>
</TR>
<TR>
<TD><Font face="arial" size="2pt">Sender User Name:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="TEXT" Size=30 Name="SendUserName"></TD>
</TR>
<TR>
<TD><Font face="arial" size="2pt">Sender User PSWD:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="PASSWORD" ID="PSWD1" SIZE=30 NAME = "SendUserPSWD1"></Font></TD>
</TR>
<TR>
<TD><Font face="arial" size="2pt">Confirm User PSWD:</TD>
<TD><Font face="arial" size="2pt"><INPUT TYPE="PASSWORD" ID="PSWD2" SIZE=30 NAME = "SendUserPSWD2"></Font></TD>
</TR>
<TR>
</Table></Center>
<FONT <Font color="#FF3333" size="1pt"><BR><B><Center><DIV ID=divProgress STYLE="font-size:30">...</B></DIV></Font></CENTER>
<P><Font face="arial" size="2pt"><Center><INPUT TYPE="BUTTON" SIZE=50 NAME="Execute" VALUE="Start" > <INPUT TYPE="BUTTON" SIZE=50 NAME="Terminate" VALUE="Stop" ></Font></CENTER>
</FORM>
</BODY>
</HTML>

<SCRIPT LANGUAGE="VBSCRIPT">
<!-- Option Explicit
'************************************************************************************
'* TrackMyIP.HTA *
'************************************************************************************
'* *
'* This is a sample HTA with embedded VBScript code. The intent is to show how an *
'* HTA can be coded with some input boxes and push buttons and a display area. *
'* *
'************************************************************************************
Dim fso,wshShell,OutputFileName,ExternalIPAddress,HeldExternalIP,CurrentPath,idTimer,_
VBScriptFileName

'************************************************************************************
'* This subroutine is executed when the HTA Windows is first opened. For the most *
'* part this is program initialization stuff. *
'************************************************************************************
Sub window_OnLoad()
Dim form
Set form = document.TrackMyIPForm
ScreenHeight = screen.availHeight
ScreenWidth = screen.availWidth
WindowWidth = 420
WindowHeight = 520
WindowLeft = (ScreenWidth-WindowWidth)*.5
WindowTop = (ScreenHeight-WindowHeight)*.25
window.resizeto WindowWidth,WindowHeight
window.moveTo WindowLeft, WindowTop
form.SenderFirstName.value = ""
form.SenderLastName.value = ""
form.SendFromAddr.value = ""
form.SendToAddr.value = ""
form.SMTPServer.value = ""
form.SendUserName.value = ""
form.SendUserPSWD1.value = ""
form.SendUserPSWD2.value = ""
Set Fso = CreateObject("Scripting.FileSystemObject")
ExternalIPAddress = ""
HeldExternalIP = ""
CurrentPath = Fso.GetAbsolutePathName(".")
OutputFileName = CurrentPath & "\TrackMyIP.txt"
Call GetEmailInfo
If form.SendUserPswd1.value <> "" then
document.getElementByID("PSWD2").disabled = True
End If
if form.SenderFirstName.value = "" then
form.SenderFirstName.focus
else
form.Execute.focus
end if
End Sub

'************************************************************************************
'* This subroutine handles the encryption of any new password in the Password1 *
'* and changes the status of the Password2 field which is normally disabled. *
'************************************************************************************
sub SendUserPSWD1_OnChange()
Dim form
Set form = document.TrackMyIPForm
form.SendUserPSWD1.value = EnDeCrypt(form.SendUserPSWD1.value)
document.getElementByID("PSWD2").disabled = False
form.SendUserPSWD2.value = ""
form.SendUserPSWD2.focus
end sub

'************************************************************************************
'* This subroutine handles the encryption of any new password in the Password2 *
'* field handles the status of the Password2 field which is normally disabled. This *
'* subroutine also handles the situation where the two passwords don't match since *
'* the end user cannot see the password in clear text. *
'************************************************************************************
sub SendUserPSWD2_OnChange()
Dim form
Set form = document.TrackMyIPForm
form.SendUserPSWD2.value = EnDeCrypt(form.SendUserPSWD2.value)
if form.SendUserPSWD1.value <> form.SendUserPSWD2.value then
MsgBox "Passwords do not match. Plese re-enter both passwords"
form.SendUserPSWD1.value = ""
form.SendUserPSWD2.value = ""
form.SendUserPSWD1.focus
else
document.getElementByID("PSWD2").disabled = True
form.Execute.focus
end if
end sub

'************************************************************************************
'* This subroutine handles the events that take place when the end user presses the *
'* Execute button. In this subroutine the external file is written out. *
'************************************************************************************
Sub Execute_OnClick()
Dim form,Fso,oStream,WshShell,InputLine,InputArray,KeyWord,Command
set form = document.TrackMyIPForm
Set Fso = CreateObject("Scripting.FileSystemObject")
Set oStream = Fso.CreateTextfile(OutputFileName)
Set WshShell = CreateObject("WScript.Shell")
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
strSystemRoot = wshShell.ExpandEnvironmentStrings( "%SYSTEMROOT%" )
Call GetExternalIP
oStream.WriteLine "SenderFirstName:" & form.SenderFirstName.value
oStream.WriteLine "SenderLastName:" & form.SenderLastName.value
oStream.WriteLine "SendFromAddr:" & form.SendFromAddr.value
oStream.WriteLine "SendToAddr:" & form.SendToAddr.value
oStream.WriteLine "SMTPServer:" & form.SMTPServer.value
oStream.WriteLine "SendUserName:" & form.SendUserName.value
oStream.WriteLine "SendUserPSWD1:" & form.SendUserPSWD1.value
oStream.WriteLine "SendUserPSWD2:" & form.SendUserPSWD2.value
oStream.writeLine "ExternalIPAddress:" & ExternalIPAddress
ostream.close
End Sub

'************************************************************************************
'* This subroutine handles the events that take place when the end user presses the *
'* Stop button. In this subroutine simply closes the hypertext application. *
'************************************************************************************
Sub Terminate_OnClick()
self.close
End Sub

'************************************************************************************
'* Once the external email info is written to the TrackMyIP.txt file the first time *
'* it is re-used the next time the program is used and this get the old info. *
'************************************************************************************
Sub GetEmailInfo()
Dim form,Fso,oStream,InputLine,InputArray,KeyWord
set form = document.TrackMyIPForm
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(OutputFileName) Then
Set ostream = Fs

penTextFile(OutputFileName)
Do While not(ostream.atEndOfStream)
InputLine = ostream.ReadLine
if instr(inputline,":") then
InputArray = Split(InputLine,":")
Keyword = InputArray(0)
Select Case KeyWord
Case "SenderFirstName"
form.SenderFirstName.value = InputArray(1)
Case "SenderLastName"
form.SenderLastName.value = InputArray(1)
Case "SendFromAddr"
form.SendFromAddr.value = InputArray(1)
Case "SendToAddr"
form.SendToAddr.value = InputArray(1)
Case "SMTPServer"
form.SMTPServer.value = InputArray(1)
Case "SendUserName"
form.SendUserName.value = InputArray(1)
Case "SendUserPSWD1"
form.SendUserPSWD1.value = InputArray(1)
Case "SendUserPSWD2"
form.SendUserPSWD2.value = InputArray(1)
Case "ExternalIPAddress"
Case Else
End Select
End If
Loop
ostream.close
End If
End Sub

'************************************************************************************
'* This subroutine goes out to the Internet and grabs the external IP address that *
'* is assigned to this computer. *
'************************************************************************************
Sub GetExternalIP()
Dim objIE
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate "

http://checkip.dyndns.org/"

' or "

http://checkip.dyndns.org:8245/"

objIE.Visible = False
Do While objIE.Busy
idTimer = window.setTimeout("PausedSection", 1000, "VBScript")
Loop
ExternalIPAddress = objIE.Document.body.innerhtml
ExternalIPAddress = Trim(Mid(ExternalIPAddress,inStr(ExternalIPAddress,":") + 2))
divProgress.InnerText = ExternalIPAddress
Set objIE = Nothing
End Sub

'************************************************************************************
'* HTA's don't have a SLEEP function capability so a Timer is needed to control *
'* the wait function. Each time the time is set it must be cleared *
'************************************************************************************
Sub PausedSection
window.clearTimeout(idTimer)
End Sub

'************************************************************************************
'* Encrypts/decrypts the SendUserPSWD value so then when the TrackMyIP.TXT file is *
'* saved the information is not shown in clear text. *
'************************************************************************************
Function EnDeCrypt(plaintxt)
Dim sbox(255), key(255), a, b, h, i, j, k, cipherby, cipher, temp, tempswap, intLength, psw
i = 0
j = 0
psw = "LswPPlKXQJ"
intLength = Len(psw)
For a = 0 To 255
key(a) = Asc(Mid(psw, (a Mod intLength) + 1, 1))
sbox(a) = a
Next
b = 0
For a = 0 To 255
b = (b + sbox(a) + key(a)) Mod 256
tempswap = sbox(a)
sbox(a) = sbox(b)
sbox(b) = tempswap
Next
For h = 1 To Len(plaintxt)
i = (i + 1) Mod 256
j = (j + sbox(i)) Mod 256
temp = sbox(i)
sbox(i) = sbox(j)
sbox(j) = temp
k = sbox((sbox(i) + sbox(j)) Mod 256)
cipherby = Asc(Mid(plaintxt, h, 1)) Xor k
cipher = cipher & Chr(cipherby)
Next
EnDeCrypt = cipher
End Function
-->
</SCRIPT>
</BODY>
</HTML>

GomezAddamz · Sep 16, 2014

Thank you very much for the feedback. I'm sorry for the poor explanation. I know I can use events to trigger subroutines, but what I want to do is have a subroutine wait for an event before continuing.

I was hoping to keep this simple, but it seems some context is needed. I'm working on a project to turn websites into epubs. I can use HTTrack to rip the site, and I can use Calibre to convert the HTML, but I'm trying to develop some custom scripts to smooth out the conversion. I've already written a VBS that will strip out the chaff of the HTML, now I'm trying to develop a script that will facilitate importing the HTML files in the proper order. The first script creates a log.csv file that lists the title from the source HTML file and the path to the HTML file. I have manually created a separate TOC.txt file that provides the order that the log.csv files should be in.

I originally wrote a VBS that would read a line from the TOC, search the log for a match, and then write the match to an index.html file. That much is working, the only hiccup is that a line of the TOC file does not necessarily uniquely define an entry in the log (indeed, it could define every entry in the log!). So I need the user (i.e. - me) to be able to select from a list of options before the script can continue. I couldn't find a clean way to do this in VBS, so I switched to HTA. I can populate the list box dynamically, but what I can't do is wait for the user make a selection before continuing. Full code is below (note I haven't finished the VBS to HTA conversion, hence the wscript references):

Code:

<html>
<head>
<title>Indexer</title>

<HTA:APPLICATION 
     ID="objTestHTA"
     APPLICATIONNAME="Indexer"
     SINGLEINSTANCE="yes"
>
</head>

<SCRIPT Language="VBScript">
Option Explicit

Dim objShell, FSO, objDictionary, objOption, sourceFolder, logFile, tocFile, indexFile
Dim sourceDir, logFileName, tocFileName, logStr, tocStr, tabLevel, chapName, keyIndex
Dim path, title, tmpStr, i

Sub Window_onLoad
	Set objShell = CreateObject("Shell.Application")
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set objDictionary = CreateObject("Scripting.Dictionary")
	
	logFileName = "log.csv"
	tocFileName = "toc.txt"
	
	'Get source directory
	Set sourceFolder = objShell.BrowseForFolder(0, "Browse For Folder", 0, 0)
	If Not sourceFolder Is Nothing Then
		sourceDir = sourceFolder.self.path
	Else
		wscript.echo "No folder selected. Exiting."
		wscript.quit
	End If
	
	'Check for toc.txt
	If Not FSO.FileExists(sourceDir & "\" & tocFileName) Then
		wscript.echo "TOC file does not exist. Create a file named """ & tocFileName & """ in the Parsed directory and try again."
		wscript.quit
	End If
	
	'Check for log.csv file
	If Not FSO.FileExists(sourceDir & "\" & logFileName) Then
		wscript.echo "Log file does not exist. Re-run ExtractHTML script to generate log file and try again."
		wscript.quit
	End If
	
	'Compare number of lines in log.csv to toc.txt
	Set logFile = FSO.OpenTextFile(sourceDir & "\" & logFileName,1)
	Set tocFile = FSO.OpenTextFile(sourceDir & "\" & tocFileName,1)
	logFile.ReadAll
	tocFile.ReadAll
	
	If Not (logFile.Line - 1) = tocFile.Line Then
		wscript.echo "Line counts of log file and TOC file do not match. TOC file should end with an empty line. Verify files and try again."
		wscript.quit
	End If
	
	logFile.Close
	tocFile.Close
	
	'If everything looks good, create index.html file
	Set indexFile = FSO.OpenTextFile(sourceDir & "\index.html",2,1)
	indexFile.WriteLine("<html>")
	indexFile.WriteLine("<head>")
	indexFile.WriteLine("<title>")
	indexFile.WriteLine("Table of Contents")
	indexFile.WriteLine("</title>")
	indexFile.WriteLine("</head>")
	indexFile.WriteLine("<body>")
	
	'Get first line of toc.txt, count number of leading tabs, compare to every line of log.csv
	Set tocFile = FSO.OpenTextFile(sourceDir & "\" & tocFileName,1)
	
	Do Until tocFile.AtEndOfStream
		tocStr = tocFile.ReadLine
		tabLevel = UBound(Split(tocStr,vbTab)) + 1
		tocStr = Split(tocStr,vbTab)(UBound(Split(tocStr,vbTab)))
		If tabLevel = 1 Then
			chapName = tocStr
		End If
		CheckLog(tocStr)
		If keyIndex = 0 Then
			While objDictionary.Count = 0 
				tocStr = InputBox("Could not find """ & chapName & ": " & tocStr & """ in log. Enter custom string to try again.","Indexer")
				CheckLog(tocStr)
			Wend
		End If
		If keyIndex = 1 Then
			title = Split(objDictionary.Item(0),";")(0)
			path = Split(objDictionary.Item(0),";")(1)
			indexFile.WriteLine("<a href=""file:///" & path & """>" &  title & "</a><br>")
		Else
			'Clear list box
			For Each objOption in options.Options
				objOption.RemoveNode
			Next
			'Prompt user to select from options
			document.getElementByID("message").innerHTML = """" & chapName & ": " & tocStr & """ has " & objDictionary.Count & " possible matches in log."
			For i=0 To objDictionary.Count - 1
				Set objOption = document.createElement("OPTION")
				objOption.Text = Split(objDictionary.Item(i),";")(0)
				objOption.value = objDictionary.Item(i)
				options.Add(objOption)
			Next
			'**** This is where I need to get the user selection from the list box
			SleepWait(0) 'Give the display a change to update.
			'Split selected option to title/path vars
		End If
		'indexFile.WriteLine("<a href=""file:///" & path & """>" &  title & "</a><br>")
		'Open source html file and replace current heading level with new heading level
	Loop
	tocFile.Close
	indexFile.WriteLine("</body>")
	indexFile.WriteLine("</html>")
	indexFile.Close
	document.getElementByID("message").innerHTML = "Index file created!"
End Sub

Sub CheckLog(tmpStr)
	Set logFile = FSO.OpenTextFile(sourceDir & "\" & logFileName,1)
	objDictionary.RemoveAll
	keyIndex = 0
	Do Until logFile.AtEndOfStream
		logStr = logFile.ReadLine
		If InStr(logStr,tmpStr) <> 0 Then
			objDictionary.Add keyIndex, logStr
			keyIndex = keyIndex + 1
		End If
	Loop
	logFile.Close
End Sub

Sub SleepWait(seconds) 'Allows application to wait, if needed.
  Dim oShell,cmd
  Set oShell = CreateObject("Wscript.Shell")
  cmd = "%COMSPEC% /c ping -n " & 1 + seconds & "127.0.0.1>nul"
  oShell.Run cmd,0,1
End Sub

</SCRIPT>

<body>
<p id="message"></p>
<button>Submit</button><br>
<select id="options" size="40">
</select>
<iframe id="preview" src="" width="640px" height="640px"> 
</body>
</html>

GomezAddamz · Sep 19, 2014

I realized I was using faulty logic. I was thinking in terms of "VBS OR HTA", when I needed to be thinking in terms of "VBS AND HTA". I kept the main VBS script, and wrote a separate HTA to handle the user selection. I'm calling the HTA with WshShell.run with "Wait on Return" set to "True". The scripts are configured to use a temp file to pass data back and forth. The VBS still needs some tweaking, but if you're curious, here's the current code:

Code:

<html>
<head>
<title>SelectHTML</title>

<HTA:APPLICATION 
     ID="SelectHTMLHTA"
     APPLICATIONNAME="SelectHTML"
     SINGLEINSTANCE="yes"
>
</head>

<script Language="VBScript">
	Option Explicit
	
	Dim FSO, objOption, logFile, logFilePath, logFileStr
	
	Set FSO = CreateObject("Scripting.FileSystemObject")
	
	Sub Window_onLoad
		logFilePath = Split(SelectHTMLHTA.commandLine, chr(34))(3)
		Set logFile = FSO.OpenTextFile(logFilePath,1)
		document.getElementByID("message").innerHTML = logFile.ReadLine
		Do Until logFile.AtEndOfStream
			logFileStr = logFile.ReadLine
			Set objOption = document.createElement("OPTION")
			objOption.value = logFileStr
			objOption.Text = Split(logFileStr,";")(0)
			options.Add(objOption)
		Loop
	End Sub
	
	Sub Preview_Selection
		document.getElementByID("preview").src = "file:///" & Split(options.Options(options.SelectedIndex).value,";")(1)
	End Sub
	
	Sub SaveLog
		Set logFile = FSO.OpenTextFile(logFilePath,2,1)
		logFile.WriteLine(options.Options(options.SelectedIndex).value)
		logFile.Close
		window.Close()
	End Sub
		
</script>
<body>
<p id="message"></p>
<button id="button1" onClick=SaveLog()>Submit</button><br>
<select id="options" size="40" style="width: 640px" onChange=Preview_Selection()></select>
<iframe id="preview" src="" width="640px" height="640px">
</body>
</html>

Code:

Option Explicit

Dim WshShell, objShell, FSO, objDictionary, sourceFolder, logFile, tocFile, outFile, indexFile
Dim sourceDir, scriptDir, logFileName, tocFileName, indexFileName, outFileName, logStr, tocStr, indexStr, tabLevel, chapName, keyIndex
Dim path, title, tmpStr, i

Set WshShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")

logFileName = "log.csv"
tocFileName = "toc.txt"
indexFileName = "index.html"
outFileName = "log.txt"

scriptDir = WshShell.CurrentDirectory

'Get source directory
Set sourceFolder = objShell.BrowseForFolder(0, "Browse For Folder", 0, 0)
If Not sourceFolder Is Nothing Then
	sourceDir = sourceFolder.self.path
Else
	wscript.echo "No folder selected. Exiting."
	wscript.quit
End If

'Check for toc.txt
If Not FSO.FileExists(sourceDir & "\" & tocFileName) Then
	wscript.echo "TOC file does not exist. Create a file named """ & tocFileName & """ in the Parsed directory and try again."
	wscript.quit
End If

'Check for log.csv file
If Not FSO.FileExists(sourceDir & "\" & logFileName) Then
	wscript.echo "Log file does not exist. Re-run ExtractHTML script to generate log file and try again."
	wscript.quit
End If

'Compare number of lines in log.csv to toc.txt
Set logFile = FSO.OpenTextFile(sourceDir & "\" & logFileName,1)
Set tocFile = FSO.OpenTextFile(sourceDir & "\" & tocFileName,1)
logFile.ReadAll
tocFile.ReadAll

If Not (logFile.Line - 1) = tocFile.Line Then
	wscript.echo "Line counts of log file and TOC file do not match. TOC file should end with an empty line. Verify files and try again."
	wscript.quit
End If

logFile.Close
tocFile.Close

'If everything looks good, create index.html file
Set indexFile = FSO.OpenTextFile(sourceDir & "\" & indexFileName,2,1)
indexFile.WriteLine("<html>")
indexFile.WriteLine("<head>")
indexFile.WriteLine("<title>")
indexFile.WriteLine("Table of Contents")
indexFile.WriteLine("</title>")
indexFile.WriteLine("</head>")
indexFile.WriteLine("<body>")

'Get first line of toc.txt, count number of leading tabs, compare to every line of log.csv
Set tocFile = FSO.OpenTextFile(sourceDir & "\" & tocFileName,1)

Do Until tocFile.AtEndOfStream
	tocStr = tocFile.ReadLine
	tabLevel = UBound(Split(tocStr,vbTab)) + 1
	tocStr = Split(tocStr,vbTab)(UBound(Split(tocStr,vbTab)))
	If tabLevel = 1 Then
		chapName = tocStr
	End If
	CheckLog(tocStr)
	If keyIndex = 0 Then
		While objDictionary.Count = 0 
			tocStr = InputBox("Could not find """ & chapName & ": " & tocStr & """ in log. Enter custom string to try again.","ProcessHTML")
			CheckLog(tocStr)
		Wend
	End If
	If keyIndex = 1 Then
		indexStr = objDictionary.Item(0)
	Else
		Set outFile = FSO.OpenTextFile(sourceDir & "\" & outFileName,2,1)
		outFile.WriteLine("""" & chapName & ": " & tocStr & """ has " & objDictionary.Count & " possible matches in log.")
		For i=0 To objDictionary.Count - 1
			outFile.WriteLine(objDictionary.Item(i))
		Next
		outFile.Close
		WshShell.run """" & scriptDir & "\SelectHTML.hta"" """ & sourceDir & "\" & outFileName & """", 1, True
		Set outFile = FSO.OpenTextFile(sourceDir & "\" & outFileName,1)
		indexStr = outFile.ReadLine
		outFile.Close
	End If
	title = Split(indexStr,";")(0)
	path = Split(indexStr,";")(1)
	indexFile.WriteLine("<a href=""file:///" & path & """>" &  title & "</a><br>")
	'Open source html file and replace current heading level with new heading level
Loop
tocFile.Close
indexFile.WriteLine("</body>")
indexFile.WriteLine("</html>")
indexFile.Close
wscript.echo "Index file created!"


Sub CheckLog(tmpStr)
	Set logFile = FSO.OpenTextFile(sourceDir & "\" & logFileName,1)
	objDictionary.RemoveAll
	keyIndex = 0
	Do Until logFile.AtEndOfStream
		logStr = logFile.ReadLine
		If InStr(logStr,tmpStr) <> 0 Then
			objDictionary.Add keyIndex, logStr
			keyIndex = keyIndex + 1
		End If
	Loop
	logFile.Close
End Sub

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

HTA: Wait for event before continuing script

GomezAddamz

Technical User

VulcanJedi

Technical User

crackoo

Programmer

wchull

MIS

GomezAddamz

Technical User

GomezAddamz

Technical User

Similar threads

Part and Inventory Search

Sponsor