OK, I have a nifty VBS that will search huge log files for certain character strings, but I don't always want to search every log file for every string. I'd like an HTA frontend that allows the end user to select what strings they want to look for.
Here is a sample of my code and it works great as a vb, but in this example, i'd like checkboxes for cows, goats, cats, dogs, etc.. and for the script to run correctly no matter how many are selected.. (my actual script has about 20 words to choose from) and also the path and name of the 'animal log file' is currently an input box.. i'd like that in the hta as well.
Const ForReading = 1
Dim words(7)
Dim msg
words(0) = "cows"
words(1) = "goats"
words(2) = "cats"
words(3) = "dogs"
words(4) = "elephants"
words(5) = "giraffes"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strAnswer = InputBox("Please enter the path & filename for the animal log file:", _
"Create File")
Wscript.Echo strAnswer
Set objFile = objFSO.OpenTextFile( strAnswer, ForReading)
Set inFile = objFSO.OpenTextFile ( strAnswer, ForReading)
strContents = objFile.ReadAll
objFile.Close
Set outFile = objFSO.OpenTextFile( strAnswer &"_parsed-output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
WScript.Echo "Done!"
This can get you started. You will need to code in how to handle if multiple checkboxes are selected and the code logic required to open those log files (multiple log files). You can find more info about HTAs here, http://technet.microsoft.com/en-us/scriptcenter/dd742317.aspx
<html>
<head>
<title>My Logfile App</title>
<HTA:APPLICATION
APPLICATIONNAME="My Logfile App"
ID="MyLogfileApp"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
window.resizeto 300,300
End Sub
Sub Start_Button()
Const ForReading = 1
Dim objFSO, objFile, inFile, strAnswer
strAnswer = ""
If chkCows.Checked Then strAnswer = "Cows"
If chkGoats.Checked Then strAnswer = "Goats"
If chkCats.checked Then strAnswer = "Cats"
If chkDogs.Checked Then strAnswer = "Dogs"
If chkElephants.Checked Then strAnswer = "Elephants"
If chkGiraffes.Checked Then strAnswer = "Giraffes"
'If strAnswer is empty then nothing was checked.
If strAnswer = "" Then
Window.Alert "Please Make an Selection!"
Exit Sub
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile( strAnswer, ForReading)
Set inFile = objFSO.OpenTextFile ( strAnswer, ForReading)
strContents = objFile.ReadAll
objFile.Close
Set outFile = objFSO.OpenTextFile( strAnswer &"_parsed-output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
Window.Alert "Done!"
End Sub
</script>
<body bgcolor="white">
<center>
<label>Choose your logfile below.</label><br />
</center>
<input type="checkbox" name="chkCows" id="chkCows">Cows<br />
<input type="checkbox" name="chkGoats" id="chkGoats">Goats<br />
<input type="checkbox" name="chkCats" id="chkCats">Cats<br />
<input type="checkbox" name="chkDogs" id="chkDogs">Dogs<br />
<input type="checkbox" name="chkElephants" id="chkElephants">Elephants<br />
<input type="checkbox" name="chkGiraffes" id="chkGiraffes">Giraffes<br />
<p>
<center>
<input type="button" name="btnStart" id="btnStart" value="Start" onclick="Start_Button">
</center>
</body>
</html>
Related
Using an Onload command I can output the relevant files from a folder in a messagebox but cannot understand how to use that information to populate a drop down menu in the html code.
Sub Window_onLoad
LoadDropDown
End Sub
Sub LoadDropDown
Dim dir, foundFile
dir = zipfolder
Dim fileNames, fso, folder
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(dir)
For Each foundFile In folder.Files
fileNames = foundFile.name
If(Right(fileNames,4) = ".zip") then
fileNames = Left(fileNames,(Len(fileNames)-4))
Value = Value & fileNames & vbCr
MsgBox "inside sub Value : " & Value
End If
Next
End Sub
This will display a msgbox for each file found with extension ".zip"
The confusing part is how to display this information (on load) in a drop down menu???
What am I missing from the below?
<select id="test" name="test" onchange="LoadDropDown" style="width: 336px;">
<option value=""></option>
</select>
Thank you in advance for any help!
This is NOT the same as:
How to output all sub-folder to a drop down list in a HTA?
They are not using a file filter and mouseover on populate is NOT what is required or even wanted.
You can try like this to auto-populate your drop down menu :
I have tested this in the temporary folder to populate *.tmp files, so you can change it for your needs
<html>
<HTA:APPLICATION ICON="magnify.exe"/>
<head>
<Title>Load DropDown Menu</Title>
<script language="vbscript">
Option Explicit
Dim ws,Temp,dir,objOption,Ext
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Dir = Temp
Ext = "tmp"
'---------------------------------------------------------------
Sub Window_onLoad
Call LoadDropDown(Dir,Ext)
End Sub
'---------------------------------------------------------------
Sub LoadDropDown(Dir,Ext)
Dim fso,folder,foundFile,fileNames,objOption,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Dir)
Count = 0
Call ClearListbox()
For Each foundFile In folder.Files
fileNames = FSO.GetBaseName(foundFile)
if Lcase(fso.getExtensionName(foundFile.path)) = Lcase(Ext) then
Count = Count + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = Count & " - " & fileNames
objOption.Value = foundFile.path
DropDown.Add(objOption)
End If
Next
End Sub
'---------------------------------------------------------------
Sub ClearListbox()
For Each objOption in DropDown.Options
objOption.RemoveNode
Next
End Sub
'---------------------------------------------------------------
Sub Explorer(File)
MsgBox File
ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'---------------------------------------------------------------
</script>
</head>
<select id="DropDown" name="DropDown" onchange="Explorer(DropDown.value)" style="width: 336px;">
</select>
</body>
</html>
Based on your last comment
How can i add more than extension file in the dropdown listbox ?
<html>
<HTA:APPLICATION ICON="magnify.exe"/>
<head>
<Title>Load DropDown Menu</Title>
<script language="vbscript">
Option Explicit
Dim ws,Temp,dir,objOption,ArrayExtensions,Ext
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Dir = Temp
ArrayExtensions = Array("exe","bat","cmd","vbs","ps1","zip","rar","tmp")
'---------------------------------------------------------------
Sub Window_onLoad
Call ClearListbox()
For each Ext in ArrayExtensions
Call LoadDropDown(Dir,Ext)
Next
End Sub
'---------------------------------------------------------------
Sub LoadDropDown(Dir,Ext)
Dim fso,folder,foundFile,fileNames,objOption,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Dir)
Count = 0
For Each foundFile In folder.Files
fileNames = FSO.GetBaseName(foundFile)
if Lcase(fso.getExtensionName(foundFile.path)) = Lcase(Ext) then
Count = Count + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = "[" & Ext & "] - " & Count & " - " & foundFile.Name
objOption.Value = foundFile.path
DropDown.Add(objOption)
End If
Next
End Sub
'---------------------------------------------------------------
Sub ClearListbox()
For Each objOption in DropDown.Options
objOption.RemoveNode
Next
End Sub
'---------------------------------------------------------------
Sub Explorer(File)
MsgBox File
ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'---------------------------------------------------------------
</script>
</head>
<select id="DropDown" name="DropDown" onchange="Explorer(DropDown.value)" style="width: 336px;">
</select>
</body>
</html>
Here is an example:
<html>
<head>
<script language="vbscript">
Sub Init
document.getElementById("option1").innerText = "Sample 1"
document.getElementById("option2").innerText = "Sample 2"
End Sub
</script>
</head>
<body onLoad="Init()">
<select id="test" name="test" style="width: 336px;">
<option id="option1"></option>
<option id="option2"></option>
</select>
</body>
</html>
I am using some vbscript to search for string inside a directory. Now I need my script to search for multiple instance of string in each file and return line number or some other identifiable information. My current vbscript is :-
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Test = Instr(contents.readall, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine thing.path
demo.innerHtml = demo.innerHtml & thing.path & "<br>"
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
I need to iterate through lines of each file to get line numbers containing string.
Reads each line and searches each line. Also remembers the previous search and directory.
Two issues that you can fix.
It will now hits the 5 million statement timeout message esp if going through exe files.
It won't find Unicode text.
This is the third time I've written the program.
<HTML>
<HEAD><TITLE>Simple Validation</TITLE>
<SCRIPT LANGUAGE="VBScript">
Dim Dirname
Dim Searchterm
Dim FSO
Dim objOutFile
Sub Browse
On Error Resume Next
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
If Err.number<>0 Then
MsgBox "Error Setting up Browse for Folder"
Else
A = bff.ParentFolder.ParseName(bff.Title).Path
If err.number=424 then err.clear
tb2.value = A
End If
End Sub
Sub Search
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Searchterm", tb1.value
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Directory", tb2.value
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("results.txt",True)
Dirname = tb2.value
Searchterm = tb1.value
ProcessFolder DirName
End Sub
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Linenum = 0
Do Until contents.AtEndOfStream
line = contents.readline
Linenum = Linenum + 1
Test = Instr(line, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine LineNum & " " & thing.path
Loop
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
Sub Init
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
tb1.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Searchterm")
tb2.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Directory")
End Sub
</script>
</head>
<body Onload=Init>
<p><INPUT Name=tb1 TYPE=Text Value="Search">
<p><INPUT Name=tb2 TYPE=Text Value="Folder"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick=Search>
</body>
</html>
I am having trouble displaying a log file in the TextArea of a HTA while a robocopy script is running.
The script is simple enough, the user has one button to press to start the process, selects where they want to back up their data to, a Robocopy runs in the background and logs the work.
I cannot get the .log file to display live during the process and am always hit with an error 800A01B6.
Code below:
<html>
<head>
<title>Backup Script</title>
<HTA:APPLICATION
ID="Backup Script"
APPLICATIONNAME="Backup Script"
BORDER="thin"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<SCRIPT Language="VBScript">
Sub Window_OnLoad
intWidth = 800
intHeight = 800
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
End Sub
Sub run_Backup_Script
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")
Dim NetSharedFolder, TargetLocalFolder, Settings
'Delete Log File bigger than 10MB
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("D:\Public\Backup.log") Then
Set file = oFSO.GetFile("D:\Public\Backup.log")
if file.Size >= 10485760 Then
oFSO.DeleteFile("D:\Public\Backup.log")
End If
End If
'Set Settings
Settings = " /MIR /FFT /R:3 /LOG+:D:\Public\Backup.log"
NetSharedFolder = "D:\LocalData\" & WshNetwork.UserName
'Select Target Folder
TargetLocalFolder = BrowseFolder( "Desktop", True , "Select a destination folder")
'Backup starts
objExecute = "RoboCopy.exe " & chr(34) & NetSharedFolder & chr(34) & " " & Chr(34) & TargetLocalFolder & chr(34) & " " & Settings & chr(34)
WshShell.Run objExecute, 0, True
DisplayOutput "D:\Public\Backup.log"
End Sub
'------------------------------------------------------------------------
Sub DisplayOutput(strFileName)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFileName, 1, False)
BasicTextArea.Text = BasicTextArea.Text & VbCrLf & objFile.ReadAll
objFile.Close
End Sub
'------------------------------------------------------------------------
Function BrowseFolder( myStartLocation, blnSimpleDialog, myMessage )
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
Dim numOptions, objFolder, objFolderItem
Dim objPath, objShell, strPath, strPrompt
' Set the options for the dialog window
strPrompt = myMessage
If blnSimpleDialog = True Then
numOptions = 0 ' Simple dialog
Else
numOptions = &H10& ' Additional text field to type folder path
End If
' Create a Windows Shell object
Set objShell = CreateObject( "Shell.Application" )
' If specified, convert "My Computer" to a valid
' path for the Windows Shell's BrowseFolder method
If UCase( myStartLocation ) = "MY COMPUTER" Then
Set objFolder = objShell.Namespace( MY_COMPUTER )
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Else
strPath = myStartLocation
End If
Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
numOptions, strPath )
' Quit if no folder was selected
If objFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
' Retrieve the path of the selected folder
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
' Return the path of the selected folder
BrowseFolder = objPath
End Function
</SCRIPT>
'------------------------------------------------------------------------
<body STYLE="font:14 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')" onkeypress='vbs:Default_Buttons'>
<table width='90%' height = '50%' align='center' border='0'>
<tr>
<td align='center' colspan="4">
<h3>Backup Script</h3><br>
</td>
</tr
<tr>
<td align='center' colspan="2">
<table border="1">
<tr>
<td>
<input id="bt_Backup" type="button" value="Run Now" name="Run Now" onClick="vbs:run_Backup_Script">
</td>
</tr>
</table>
</body>
</br></br>
<textarea id="BasicTextArea" name="BasicTextArea" rows="5" cols="75"></textarea>
</html>
Can anyone see where I am going wrong?
I'm having an use where the <input type="file"> is locking the file for the ADODB.recordset.
If I hardcode the filepath the code runs without an issue however as soon as I browse using input type of file and select the hardcoded file it locks the file and I can no longer access it via the recordset.
I've tried just around everything I can think of without any success. I know its a result of the input browse function because if I select another file within the same directory or click the process button without browsing the code runs as it should.
Below is the relevant html and vbscript. Does anyone have any ideas on how to fix this?
<html>
<head>
<title>Employee Upload</title>
<HTA:APPLICATION
APPLICATIONNAME="Employee Upload"
ID="Employee Upload"
VERSION="1.0"/>
</head>
<body bgcolor="white">
<p id="heading" name="heading"><p>
<div id="container" name="container">
<span onClick="document.getElementById('myFile').click();" language="javascript" class="upload">
<button>Browse</button>
<input id="filename" type="text" disabled value="">
<input type="file" id="myFile" style="visibility:hidden;display:none;" onchange="document.getElementById('filename').value = this.value;document.getElementById('process').style.visibility = 'visible';" language="javascript">
</span>
<p>Click "Process File" once you have selected the file to upload the new hire data.</p>
<button id="process" name="process" onclick="loadFile()" style="/*visibility: hidden;*/">Process File</button>
</div>
<script language="vbscript">
Function loadFile()
On Error Resume Next
fileStr = document.all("filename").value
fileStr = "C:\Users\SeanW\Desktop\imports\NewHires.txt"
fileDir = Left(fileStr,InStrRev(fileStr,"\"))
filenameStr = Right(fileStr,Len(fileStr)-InStrRev(fileStr,"\"))
Set oConn = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fileDir & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
oRS.Open "SELECT * FROM [" & filenameStr & "]", oConn, 3, 3, 1
If Err.Number <> 0 Then
MsgBox "Error Loading File: " & vbCrLf & vbCrLf & Err.Description,vbCritical,"File Load Error"
oConn.Close
oRS.Close
Set oConn = Nothing
Set oRs = Nothing
Err.Clear
Exit Function
else
Msgbox "File Loaded Successfully"
oConn.Close
oRS.Close
Set oConn = Nothing
Set oRs = Nothing
End If
End Function
</script>
</body>
</html>
I had exactly this problem today. I got around it by making a copy of the input file in a subfolder, then connecting to that with the ADODB.Connection
dim txtfile: txtfile = document.getElementById("filename").Value
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim tablename: tablename = fso.GetFileName(txtfile)
' we'll create the folder as a subfolder to the current one
dim currentfolder: currentfolder = fso.GetAbsolutePathName(".")
' create new paths until we have a new one
dim newpath: newpath = fso.BuildPath(currentfolder, fso.GetTempName())
do while fso.folderExists(newpath)
newpath = fso.BuildPath(currentfolder, fso.GetTempName())
loop
' create the folder & copy the input file
fso.createFolder newpath
fso.copyfile txtfile, fso.buildpath(newpath, tablename)
'connect and process
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & newpath & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
ado.open
'... etc
' clear up the temp folder
fso.deleteFolder newpath, true
I am new to posting to Stack but have been using this site to solve a lot of coding issues so I know some of the basics. I have tried for hours (that's a lot for me on one issue) to get past this problem. I am creating a local tool (HTA) to eventually manage CSV files however I am stuck on this first part.
I am creating an explorer type selection tool where you pick the root folder it will load each subfolder as a button, it works great except if a subfolder has a space it spits out "Unterminated String Constant". I have worked around most the issues but since I want it to call back using this name I can not simply take out the space or replace it because clicking it's button will not work.
Any help would be VERY appreciated!
P.S. It's unfinished and I am so sorry there are no comments or descriptions...
P.S.S. Please let me know any noob things you see too... whether it be site etiquette, or coding. Thanks!!! Stackoverflow has been a huge help for me!!!
Issue is on line:
strHtml = strHtml & "<td><input type=button value='" & strFolderName & "' name=btn_'" & strFolderName & "' onClick=btnCall('" & objFolder.Name & "')></td><Br>"
Full Code is below:
<html>
<head>
<title>CSV Menu Selector</title>
<hta:application
scroll="no"
singleinstance="no"
windowstate="normal"
>
</head>
<script type="text/vbscript">
Dim objPath
Dim Master
Dim Master1
Dim g_date_input ' globally saved input object
Function GetDate(obj)
div1.style.visibility="visible"
set g_date_input = obj
End Function
Sub cal1_click()
g_date_input.value = cal1
div1.style.visibility="hidden"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''BrowseFolders'''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub BrowseSub
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Enumerate :", (0),17)
If objFolder Is Nothing Then
Exit Sub
Else
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
End If
ShowData
End Sub
Sub txtFile_OnkeyPress
If window.event.Keycode = 13 Then
objPath = txtFile.value
ShowData
End If
End Sub
Sub ShowData
If objPath = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}" Then
objPath = "C:\"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(objPath) Then
txtFile.value = objPath
Else
MsgBox "Unable to use this path:" & vbCrLf & objPath
Exit Sub
End If
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)
'For each objFolder in objFolder.Subfolders
'If objFolder.Subfolders.Count > 0 Then
strHtml = "<html><body><table>"
//msgbox objFolder.Subfolders.Count
For each objFolder in objFolder.Subfolders
Set objOption = Document.createElement("OPTION")
objOption.text = objFolder.Subfolders
objOption.value = objFolder.Subfolders
//msgbox "objFolder: " & objFolder
strFolderName = Replace(objFolder.Name," ","_")
strFolderName2 = Replace(objFolder.Name," "," ")
//msgbox "NoBlanks: " & strFolderName
Window.Document.Title = "Information For " & objPath
strHtml = strHtml & "<td><input type=button value='" & strFolderName & "' name=btn_'" & strFolderName & "' onClick=btnCall('" & objFolder.Name & "')></td><Br>"
//Msgbox strHtml
'End If
Next
strHtml = strHtml & "</table></body></html>"
Msgbox strHtml
DataArea.InnerHtml = strHtml
End Sub
Sub btnCall(strBtnName)
objPath = objPath & "\" & strBtnName
msgbox "objPath: " & objPath
ShowData
End Sub
Sub CheckMaster
Master = txtFile.value
If txtFile.value ="" Then
msgbox "Please Enter Database Name"
Else
msgBox "Master is: " & Master
TrimMaster
End If
End Sub
Sub TrimMaster
Master1 = Mid(txtFile.value, 1+InStrRev(txtFile.value,"\"))
msgBox "Master1 is: " & Master1
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
</script>
<body>
<div>
<!-- Begin Browse for Folder -->
<input type="text" name="txtFile" size="50" />
<input id="btnBrowse" type="button" value="Browse..." onClick="BrowseSub" />
<input type="button" value="Submit" name="run_button" onClick="CheckMaster"><br></td>
<!-- End Browse for Folder -->
<!-- Begin Browse for Folder-->
<input Type="Button" Value="Reset" onClick="location.reload()" /><p></td>
<!-- <input Type="Button" Value="Browse For Folder" Name="Run_Button" onClick="BrowseSub"><p></td> -->
<Span Id = "DataArea"></Span><Div Align = "Center">
<!-- <select style="background-color:#ffb7d6" size="8" onActivate=LoadDropDown name="Scanners" onChange="TestSub"> -->
<!-- End Browse for Folder -->
<!-- Begin Get Dates -->
<!-- <input id="ddate1" type="text" value="click here" onclick="GetDate(me)"> -->
<!-- <input id="ddate2" type="text" value="click here" onclick="GetDate(me)"> -->
<div id="div1" style="visibility:hidden;">
<object id="cal1" classid="clsid:8E27C92B-1264-101C-8A2F-040224009C02"></object>
</div>
<!-- End Get Dates -->
</div>
</body>
</html>
Wrong quote placement. Splitted to make it more visible
Dim td
td = Array( _
"<td>" _
, "<input type='button'" _
, " value='", objFolder.Name, "'" _
, " name='btn_" , strFolderName, "'" _
, " onClick='btnCall(""" , objFolder.Name , """)'" _
, "></td><br>" _
)
strHtml = strHtml & Join(td,"")
Try using this helpful Function DblQuote(Str) to add the double quotes into a variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
So your code become something like that :
<html>
<head>
<title>CSV Menu Selector</title>
<hta:application
scroll="no"
singleinstance="no"
windowstate="normal"
>
</head>
<script type="text/vbscript">
Dim objPath
Dim Master
Dim Master1
Dim g_date_input ' globally saved input object
Function GetDate(obj)
div1.style.visibility="visible"
set g_date_input = obj
End Function
Sub cal1_click()
g_date_input.value = cal1
div1.style.visibility="hidden"
End Sub
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''BrowseFolders'''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub BrowseSub
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Enumerate :", (0),17)
If objFolder Is Nothing Then
Exit Sub
Else
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
End If
ShowData
End Sub
Sub txtFile_OnkeyPress
If window.event.Keycode = 13 Then
objPath = txtFile.value
ShowData
End If
End Sub
Sub ShowData
If objPath = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}" Then
objPath = "C:\"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(objPath) Then
txtFile.value = objPath
Else
MsgBox "Unable to use this path:" & vbCrLf & objPath
Exit Sub
End If
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)
'For each objFolder in objFolder.Subfolders
'If objFolder.Subfolders.Count > 0 Then
strHtml = "<html><body><table>"
//msgbox objFolder.Subfolders.Count
For each objFolder in objFolder.Subfolders
Set objOption = Document.createElement("OPTION")
objOption.text = objFolder.Subfolders
objOption.value = objFolder.Subfolders
//msgbox "objFolder: " & objFolder
strFolderName = Replace(objFolder.Name," ","_")
strFolderName2 = Replace(objFolder.Name," "," ")
//msgbox "NoBlanks: " & strFolderName
Window.Document.Title = "Information For " & DblQuote(objPath)
'strHtml = strHtml & "<td><input type=button value='" & strFolderName & "' name=btn_'" & strFolderName & "' onClick=btnCall(" & objFolder.Name & ")></td><Br>"
Dim td
td = Array( _
"<td>" _
, "<input type='button'" _
, " value='", objFolder.Name, "'" _
, " name='btn_" , strFolderName, "'" _
, " onClick='btnCall(" , DblQuote(objFolder.Name) , ")'" _
, "></td><br>" _
)
strHtml = strHtml & Join(td,"")
//Msgbox strHtml
'End If
Next
strHtml = strHtml & "</table></body></html>"
Msgbox strHtml
DataArea.InnerHtml = strHtml
End Sub
Sub btnCall(strBtnName)
objPath = objPath & "\" & strBtnName
msgbox "objPath: " & DblQuote(objPath)
ShowData
End Sub
Sub CheckMaster
Master = txtFile.value
If txtFile.value ="" Then
msgbox "Please Enter Database Name"
Else
msgBox "Master is: " & Master
TrimMaster
End If
End Sub
Sub TrimMaster
Master1 = Mid(txtFile.value, 1+InStrRev(txtFile.value,"\"))
msgBox "Master1 is: " & Master1
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
</script>
<body>
<div>
<!-- Begin Browse for Folder -->
<input type="text" name="txtFile" size="50" />
<input id="btnBrowse" type="button" value="Browse..." onClick="BrowseSub" />
<input type="button" value="Submit" name="run_button" onClick="CheckMaster"><br></td>
<!-- End Browse for Folder -->
<!-- Begin Browse for Folder-->
<input Type="Button" Value="Reset" onClick="location.reload()" /><p></td>
<!-- <input Type="Button" Value="Browse For Folder" Name="Run_Button" onClick="BrowseSub"><p></td> -->
<Span Id = "DataArea"></Span><Div Align = "Center">
<!-- <select style="background-color:#ffb7d6" size="8" onActivate=LoadDropDown name="Scanners" onChange="TestSub"> -->
<!-- End Browse for Folder -->
<!-- Begin Get Dates -->
<!-- <input id="ddate1" type="text" value="click here" onclick="GetDate(me)"> -->
<!-- <input id="ddate2" type="text" value="click here" onclick="GetDate(me)"> -->
<div id="div1" style="visibility:hidden;">
<object id="cal1" classid="clsid:8E27C92B-1264-101C-8A2F-040224009C02"></object>
</div>
<!-- End Get Dates -->
</div>
</body>
</html>