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>
Related
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 building a small hta with vbs. what it does is browse the folders and pickup folder or file by click first button then copy and paste to a selected location based on file type or folder name.
I need help on "Browse the files inside each folder", so far i only made "folder browser" working. Is there a way that i can browser folder and file together, picking up folder or file as i need?
<html>
<head>
<Title>File Copy </Title>
<style>
img.exco
{
position:absolute;
bottom:10px;
right:10px
}
</style>
<!--Put this sub here to avoid resize flickering.-->
<script language = "VBScript">
sub DoResize
'resize
window.resizeTo 690,350
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - 700) / 2
posTop = (screenHeight - 430) / 2
'move to centerscreen
window.moveTo posLeft, posTop
end sub
DoResize()
</script>
<HTA:APPLICATION ID=""
applicationName=""
version="1.1"
BORDER="thin"
BORDERSTYLE="static"
CAPTION="Yes"
CONTEXTMENU="no"
ICON="C:\icon\32x32.ico"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
NAVIGATABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal"
>
<script language = "VBScript">
Sub BrowseSource_OnClick()
strStartDir = "C:\work"
Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub
Function PickFolder(strStartDir)
Dim SA, F
Set SA = CreateObject("Shell.Application")
Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not F Is Nothing) Then
PickFolder = F.Items.Item.path
End If
Set F = Nothing
Set SA = Nothing
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RunScripts_OnClick()
Copy
Paste
OpenWord
End Sub
Sub Copy
End Sub
Sub Paste
msgBox "Copy Success!"
End Sub
Sub OpenWord
End Sub
</script>
</head>
<body>
<p><b><font size="4">Please select the file.</font></b></p>
<form name="Copy_To_PC">
<input type = "text" name = "txtFile" size="100" />
<input type = "button" value = "File Source" Name="BrowseSource">
<input type="button" value="Copy and Paste" name="RunScripts">
</form>
</body>
</html>
Try by the easy way like this :
<html>
<HTA:APPLICATION ID=""
applicationName=""
version="1.1"
BORDER="thin"
BORDERSTYLE="static"
CAPTION="Yes"
CONTEXTMENU="no"
ICON="C:\icon\32x32.ico"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
NAVIGATABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal"
>
<head>
<Title>File Copy </Title>
<style>
img.exco
{
position:absolute;
bottom:10px;
right:10px
}
</style>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<!--Put this sub here to avoid resize flickering.-->
<script language = "VBScript">
Call DoResize()
'***********************************************************************
sub DoResize
'resize
window.resizeTo 690,350
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - 700) / 2
posTop = (screenHeight - 430) / 2
'move to centerscreen
window.moveTo posLeft, posTop
end sub
'***********************************************************************
Sub BrowseSource_OnClick()
strStartDir = "C:\work"
Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub
'***********************************************************************
Function PickFolder(strStartDir)
Dim SA, F
Set SA = CreateObject("Shell.Application")
Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not F Is Nothing) Then
PickFolder = F.Items.Item.path
End If
Set F = Nothing
Set SA = Nothing
End Function
'***********************************************************************
Sub Pickfile(InputFile)
InputFile = Copy_To_PC.file1.value
If InputFile ="" Then
msgbox "Please you must select a file",vbExclamation,"choose file"
Else
msgBox "You have choosen this file " & InputFile,Vbinformation,"choose file"
End If
End Sub
'***********************************************************************
Sub Copy
End Sub
'***********************************************************************
Sub Paste
msgBox "Copy Success!"
End Sub
'***********************************************************************
Sub OpenWord
End Sub
'***********************************************************************
</script>
</head>
<body>
<p><b><font size="4">Please select the file.</font></b></p>
<form name="Copy_To_PC">
<input type="file" name="file1" id="file1"><br><br>
<input type = "button" value = "File Source" OnClick="pickfile(file1.value)"><br><br>
<input type = "text" name = "txtFile" size="100" />
<input type = "button" value = "Folder Source" Name="BrowseSource"><br><br>
<input type="button" value="Copy and Paste" name="RunScripts">
</form>
</body>
</html>
I share with you this function may be helps you !
BrowseForFile.vbs
'**************************************************************************************
' GetFileDlg() And GetFileDlgBar() by omen999 - may 2014 - http://omen999.developpez.com
' Universal Browse for files function
' compatibility : all versions windows and IE - supports start folder, filters and title
' note : the global size of the parameters cannot exceed 191 chars for GetFileDlg and 227 chars for GetFileDlgBar
'**************************************************************************************
Function GetFileDlg(sIniDir,sFilter,sTitle)
GetFileDlg=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
End Function
Function GetFileDlgBar(sIniDir,sFilter,sTitle)
GetFileDlgBar=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script>""").StdOut.ReadAll
End Function
' sample test
sIniDir = "C:\Windows\Fonts\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
' (sIniDir + sFilter + sTitle) size doesn't exceed 191 chars (227 for GetFileDlgBar)
' MsgBox Len(Replace(sIniDir,"\","\\")) + Len(sFilter) + Len(sTitle)
' sIniDir must be conformed to the javascript syntax
rep = GetFileDlg(Replace(sIniDir,"\","\\"),sFilter,sTitle)
MsgBox rep & vbcrlf & Len(rep)
You have a syntax error in the original script that might bite you down the road. Change NAVIGATABLE="no" to NAVIGABLE="no". Sorry if this answer gets posted twice
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>
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>