Solved

Help With HTA

Posted on 2013-06-17
31
651 Views
Last Modified: 2014-11-01
Can anyone help me out here.  I am trying to load a dropdown box from a column in an Excel file.  The Excel file is .xlsx and will be closed.  Once the dropdown has been selected, then I would like to run a batch script with a parameter defined by whats in the dropdown selection.  Thanks for the help!!


HTML & VBScript
<html> 
<head> 
<HTA:APPLICATION 
APPLICATIONNAME="Purchasing Portal"
ID="Purchasing Portal"
border="normal" 
borderStyle="normal" 
caption="yes" 
icon="I:\BI-CEW\favicon2.ico" 
maximizeButton="yes" 
minimizeButton="yes" 
showInTaskbar="no" 
windowState="normal"
innerBorder="yes"
navigable="yes"
scroll="auto"
SINGLEINSTANCE="yes"
scrollFlat="yes" />

<br>
<title>Purchasing Portal -- Presented by ADS Solutions</title>
<center>
<TABLE BORDER="1" WIDTH="1000"><TR><TD>
<center><u><H1>Inventory Stock Position</H1></u></center>
<hr>
</center>
</head>

<style>

BODY
{
   background-color: Gainsboro;
   font-family: Cambria;
   font-size: 12pt;
   margin-top: 30px;
   margin-left: 5px;
   margin-right: 5px;
   margin-bottom: 30px;
}
button
{
   background-color: Steelblue;
   font-family: Cambria;
   font-size: 12pt;
   width: 100px;
   margin-left: 0px;
}
textarea
{
   color: white;
   font-family: Cambria;
   font-size: 11pt;
}
select
{
   font-family: Cambria;
   font-size: 10pt;
   width: 300px;  
   margin-left: 0px;
}
td
{
   color: default;
   font-family: Cambria;
   font-size: 11pt;
}
</style>

<script language=VBScript>  
' Copyright 2013, Chris Wright, cwright at adsinc dot com 
 
sub Window_onload 

  LoadDropDown 
	
  Dim entry 
  set dMenus = createObject("Scripting.Dictionary") 
  for each entry in Split(sMenuItems, ",") 
    menu.innerHTML = menu.innerHTML & "&nbsp;<span id=" & entry _ 
                   & " style='padding-bottom:2px' onselectstart=cancelEvent>&nbsp;" _ 
                   & entry & "&nbsp;</span>&nbsp;&nbsp;" 
    dMenus.Add entry, Split(eval("s" & entry), ",") 
  next 
  sMenuOpen = "" 


  window.resizeTo 1150,600
    strComputer = "."
    Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
    For Each objItem in colItems
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Next
    intLeft = (intHorizontal - 1150) / 2
    intTop = (intVertical - 600) / 2
    window.moveTo intLeft, intTop
end sub 
  
Sub RunScript
    Location.Reload(True)
End Sub

sub ReturnRows
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] =""" & txtFilter.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
        if not rs.eof then
	  strData = strData & "<tr>"
          strRow = ""
          For each fld in rs.fields
            strRow = strRow & "<th>" & fld.name & "</th>"
          Next
          strData = strData & strRow & "</tr>"
        end if 
	do until rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		if fld.name = "MAX Ordered Qty" then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		else
			strRow = strRow & "<td>" & fld.value & "</td>"
		end if
	  Next
	  strData = strData & strRow & "</tr>"
	  rs.MoveNext
	Loop
	DataArea.InnerHTML = strData & "</table>"
end Sub

sub VendorName
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Name] =""" & Optionchooser.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
        if not rs.eof then
	  strData = strData & "<tr>"
          strRow = ""
          For each fld in rs.fields
            strRow = strRow & "<th>" & fld.name & "</th>"
          Next
          strData = strData & strRow & "</tr>"
        end if 
	do until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		if fld.name = "MAX Ordered Qty" then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		else
			strRow = strRow & "<td>" & fld.value & "</td>"
		end if
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop
	DataArea.InnerHTML = strData & "</table>"
end sub

Sub LoadDropDown
Dim Rs, cn, objOption 
  ClearListbox
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
	cn.Open
	Rs.Open "Select Distinct [Vendor Name] from [VPN Position$]", cn, 1, 3

    Do Until rs.EOF
	Set objOption = Document.createElement("OPTION")
	objOption.Text = rs.fields("Vendor Name")
	objOption.Value = rs.fields("Vendor Name")
	OptionChooser.Add(objOption)
	rs.MoveNext
    Loop 

End Sub

Sub ClearListbox
    For Each objOption in OptionChooser.Options
       objOption.RemoveNode
    Next
End Sub


</script> 

<!--Page layout follows--> 
<body 
<span id=dropmenu style="font:normal 10pt Cambria"></span>

<fieldset>
<b><legend>Search Criteria:</legend></b><p>
<b>Part Number: <input type="text" name="txtFilter" size="40"><br><br></b>
<b>Vendor Name: <select size="1" name="OptionChooser" onChange=""></select></b>

<br><br>
<input id=runbutton  class="button" type="button" value="Search" name="run_button"  onClick="VendorName" title="Click here to search specific values.">
<input id=runbutton  class="button" type="button" value="Refresh" name="run_button"  onClick="RunScript" title="Click here to refresh page.">
<br>
</fieldset>
<hr>
<span id=DataArea></span>
</hr>
</body> 
</html>

Open in new window


Batch
if not "%minimized%"=="" goto :minimized
   set minimized=true
   start /min cmd /C "%~dpnx0"
   goto :EOF
   :minimized
   rem runs the script in a minimized window


C:\oracle\discoverer\bin\dis51usr.exe /connect "crwright:ADS Parts Manager/PASSWORD@DB" /opendb "ADS Stocking Position By Vendor" /parameter "Supplier_Name" echo %1 /sheet ALL /export XLS "\\ads-fs1\ads\Chris Wright\Chris Wright\Daily Reports\Daily Stocking Position.xls" /batch


START "" "I:\Chris Wright\Chris Wright\Daily Projects\Miscellaneous\Daily Macros\Daily Position Macro-Working File.xlsm" /b /wait

tskill excel /a

Open in new window

0
Comment
Question by:Christopher Wright
  • 16
  • 13
31 Comments
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39255179
This can be done in the background using the Shell Execute.  I"ll post when I've sorted out the rest of your script from your other question
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39255411
So do you want this batch to run when the form first loads?  looks like it refreshes the xlsx?
Why would you wait until the drop down is selected?
0
 

Author Comment

by:Christopher Wright
ID: 39257664
I don't want the batch to run when the form first loads.  I want the user to have the ability to open the form and select a vendor name.  This would query an associated Oracle Discoverer report that exports to an excel spreadsheet.  Currently, I have the spreadsheet scripted to automatically run a macro when it opens.  The macro formats the spreadsheet and then emails the spreadsheet to a specific/hard-coded email address. Let me know if you would like for me to attach a copy of that workbook and the VBA it contains.

I realize that this is really inefficient so I am open to suggestion.  Is there some way to leave out the spreadsheet altogether? Can I have the HTA communicate with the Oracle Discoverer directly?  If the HTA cannot communicate with Oracle Discoverer, then can the HTA simply pull the info that is on the spreadsheet rather than have the spreadsheet emailed.  

Thank you again for all of your help tagit!!!
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39258042
to be honest i've got no experience in that area with oracle discoverer but the hta should be able to communicate with the database (Oracle?) that the Oracle Discover is generating the reports from but that would mean setting up the query in the hta that you use to generate the report.  Would need more info from you.

The HTA can pull the data from the spreadsheet in the same way you've been doing to get the Vendor names and query that page.

You're right, it is inefficient and prone to issues with so many steps in the process. Especially what to do if one of the steps fail.

Essentially what you're trying to do is create a more user friendly report tool for your peers?  I suspect it's either cost prohibitive or too hard for them to use Oracle Discoverer?

I implemented something similar at last job where I created a webpage that queried the database directly and displayed results based on the users selections.  Because it was a webpage it was easily accessible to everyone in the office and on VPN for the remote users.

In the meantime do you want to try and get this to work?  I would then suggest opening another question if you want to pursue the idea of a web (intranet) version
0
 

Author Comment

by:Christopher Wright
ID: 39259875
I hope I am not coming across as greedy.  Please don't think that I am, but would you be okay with doing both.  I think this would be an AMAZING opportunity to learn something while getting something accomplished at the same time.  I will open another question to address the Web Version and will provide a link to that question in my next thread.  

As pertaining to getting the HTA to work, what information do you need from me?

Thank you so much again tagit.  I am so grateful for your help and support! God bless!!
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39261177
When I'm back at my pc I can give you more detail but essentially in the onchange of your dropdown you call your batch file. To call the batch file, you use the shell object
http://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39261365
btw you're not greedy however i'll answer your original question and then i suggest opening a new question regarding the other way of doing this.  That way it doesn't confuse this solution but also gives you access other experts that will be able to help :)  Also break your question into multiple questions not ask for the whole thing at once.  It's too much to ask an expert as they would usually get paid work if they did the whole thing.
0
 
LVL 42

Accepted Solution

by:
Rob Jurd, EE MVE earned 500 total points
ID: 39261456
Ok here is the code for you to run your batch from the hta file.

I've condensed your hta and moved the scripts and css to separate files and directories.  create two folders, "css" and "scripts" where the hta file is.

index.hta
<html> 
<head> 
<HTA:APPLICATION 
	APPLICATIONNAME="Purchasing Portal"
	ID="Purchasing Portal"
	border="normal" 
	borderStyle="normal" 
	caption="yes" 
	icon="" '"I:\BI-CEW\favicon2.ico" 
	maximizeButton="yes" 
	minimizeButton="yes" 
	showInTaskbar="no" 
	windowState="normal"
	innerBorder="yes"
	navigable="yes"
	scroll="auto"
	SINGLEINSTANCE="yes"
	scrollFlat="yes" 
/>

<br>
<title>Purchasing Portal -- Presented by ADS Solutions</title>
<center>
<TABLE BORDER="1" WIDTH="1000"><TR><TD>
<center><u><H1>Inventory Stock Position</H1></u></center>
<hr>
</center>
<link rel="stylesheet" type="text/css" href="css/mystyle.css">
<script language="VBScript" src="scripts/forms.vbs"></script> 
<script language="VBScript" src="scripts/search.vbs"></script> 
<script language="VBScript" src="scripts/batch.vbs"></script> 
</head>

<!--Page layout follows--> 
<body onmouseover="menu_onmouseover" style="font:14pt Cambria"> 
<div id="menu" style="position:absolute;left:0;top:0;width:110%;height:23px; 
                    padding-top:2px;background-color:lightgrey; 
                    font:normal 12pt Cambria;z-Index:100"> 
</div> 
<span id="dropmenu" style="font:normal 10pt Cambria"></span>

<fieldset>
<b><legend>Search Criteria:</legend></b><p>
<b>Part Number: </b> <input type="text" name="txtFilter" size="40"><br><br>
<b>Vendor Name: <select size="1" name="OptionChooser" onChange="BatchRun"></select>

<br><br>
<input id="runbutton1"  class="button" type="button" value="Search" name="run_button"  onClick="DecideSearch" title="Click here to search specific values.">
<input id="runbutton2"  class="button" type="button" value="Fuzzy Search" name="run_button"  onClick="FuzzySearch" title="Click here to search partial values.">
<input id="runbutton3"  class="button" type="button" value="Refresh" name="run_button"  onClick="RunScript" title="Click here to refresh page.">
<br>
</fieldset>
<hr>
<span id=DataArea></span>
<span id=msg style="z-Index:10"></span> 
</body> 
</html>

Open in new window


css/mystyle.css
BODY
{
   background-color: Gainsboro;
   font-family: Cambria;
   font-size: 12pt;
   margin-top: 30px;
   margin-left: 5px;
   margin-right: 5px;
   margin-bottom: 30px;
}
button
{
   background-color: Steelblue;
   font-family: Cambria;
   font-size: 12pt;
   width: 100px;
   margin-left: 0px;
}
textarea
{
   color: white;
   font-family: Cambria;
   font-size: 11pt;
}
select
{
   font-family: Cambria;
   font-size: 10pt;
   width: 300px;  
   margin-left: 0px;
}
td
{
   color: default;
   font-family: Cambria;
   font-size: 11pt;
}

Open in new window


scripts/search.vbs - all your subs relating to searching the spreadsheet
' fields for connection string
Dim dataSrc

'dataSrc = "I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx"
dataSrc = "c:\users\rob\documents\ee\hta\Daily-Stocking-Position-Test-Dat.xlsx"

' Perform an exact search
sub ReturnRows
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	
	
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSrc & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] = """ & txtFilter.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
        if not rs.eof then
	  strData = strData & "<tr>"
          strRow = ""
          For each fld in rs.fields
            strRow = strRow & "<th>" & fld.name & "</th>"
          Next
          strData = strData & strRow & "</tr>"
        end if 
	do until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		if fld.name = "MAX Ordered Qty" then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		else
			On Error Resume Next
			strRow = strRow & "<td>" & fld.value & "</td>"
			On Error Goto 0
		end if
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop
	DataArea.InnerHTML = strData & "</table>"
end Sub

sub VendorName
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSrc & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Name] =""" & Optionchooser.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
	If Not Rs.EOF Then
	  strData = strData & "<tr>"
	  strRow = ""
	  For Each fld in Rs.fields
		strRow = strRow & "<th>" & fld.name & "</th>"
	  Next
	  strData = strData & strRow & "</tr>"
	End If 

	Do Until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		If fld.name = "MAX Ordered Qty" Then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		Else
			On Error Resume Next
			strRow = strRow & "<td>" & fld.value & "</td>"
			On Error Goto 0
		End If
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop

	DataArea.InnerHTML = strData & "</table>"
End Sub

Sub Combination
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSrc & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] = '" & txtFilter.value & "' AND [Vendor Name] =""" & Optionchooser.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
	If Not Rs.EOF Then
	  strData = strData & "<tr>"
	  strRow = ""
	  For Each fld in Rs.fields
		strRow = strRow & "<th>" & fld.name & "</th>"
	  Next
	  strData = strData & strRow & "</tr>"
	End If 

	Do Until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		If fld.name = "MAX Ordered Qty" Then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		Else
			On Error Resume Next
			strRow = strRow & "<td>" & fld.value & "</td>"
			On Error Goto 0
		End If
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop

	DataArea.InnerHTML = strData & "</table>"
End Sub

Sub DecideSearch
	' txtFilter is PART NUMBER
	' OptionChooser is VENDOR
	
	' Search the vendor if the part number is empty and a Vendor has been selected
	If txtFilter.value = "" AND OptionChooser.SelectedIndex > 0 Then
	 	VendorName
	ElseIf txtFilter.value <> "" AND OptionChooser.SelectedIndex = 0 Then
		ReturnRows
	Else
		' Search based on a combination of the two
		Combination
	End if
End Sub

Sub FuzzySearch
	' Search the vendor if the part number is empty and a Vendor has been selected
	' Also do not search if both are empty
	If txtFilter.value = "" AND OptionChooser.SelectedIndex > 0 THEN
	 	VendorName
	ElseIf txtFilter.value <> "" Then
		FuzzySearchGo
	Else
		CombinationFuzzy
	End if
End Sub

Sub FuzzySearchGo
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSrc & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] Like '%" & txtFilter.value & "%'", cn, 1, 3
	strData = "<table width=""100%"" border>"
        if not rs.eof then
	  strData = strData & "<tr>"
          strRow = ""
          For each fld in rs.fields
            strRow = strRow & "<th>" & fld.name & "</th>"
          Next
          strData = strData & strRow & "</tr>"
        end if 
	do until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		if fld.name = "MAX Ordered Qty" then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		else
			On Error Resume Next
			strRow = strRow & "<td>" & fld.value & "</td>"
			On Error Goto 0
		end if
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop
	DataArea.InnerHTML = strData & "</table>"
End Sub

Sub CombinationFuzzy
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSrc & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] Like '%" & txtFilter.value & "%' AND [Vendor Name] =""" & Optionchooser.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
	If Not Rs.EOF Then
	  strData = strData & "<tr>"
	  strRow = ""
	  For Each fld in Rs.fields
		strRow = strRow & "<th>" & fld.name & "</th>"
	  Next
	  strData = strData & strRow & "</tr>"
	End If 

	Do Until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		If fld.name = "MAX Ordered Qty" Then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		Else
			On Error Resume Next
			strRow = strRow & "<td>" & fld.value & "</td>"
			On Error Goto 0
		End If
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop

	DataArea.InnerHTML = strData & "</table>"
End Sub

'============================================

Open in new window


scripts/forms.vbs - relating to the hta application itself
' Copyright 2013, Chris Wright, cwright at adsinc dot com 
 
' Define menu items 
Const sMenuItems = "File,Edit,Help" 
 
' Define one submenu constant for each menu item as illustrated below 
' Each is a comma separated list in a single string 
Const sFile = "Open,Close,Save,Save As ...,Exit" 
Const sEdit = "Cut,Copy,Paste,Select All,Deselect All" 
Const sHelp = "Help, About" 
Const sHTML = "&nbsp;&nbsp;&nbsp;#sItem#&nbsp;&nbsp;&nbsp;" 
 
Dim dMenus, sMenuOpen 
 
Sub Window_onload 

  LoadDropDown 
	
  Dim entry 
  set dMenus = createObject("Scripting.Dictionary") 
  For Each entry in Split(sMenuItems, ",") 
    menu.innerHTML = menu.innerHTML & "&nbsp;<span id=" & entry _ 
                   & " style='padding-bottom:2px' onselectstart=cancelEvent>&nbsp;" _ 
                   & entry & "&nbsp;</span>&nbsp;&nbsp;" 
    dMenus.Add entry, Split(eval("s" & entry), ",") 
  Next 
  sMenuOpen = "" 

  window.resizeTo 1150,600
    strComputer = "."
    Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
    For Each objItem in colItems
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Next
    intLeft = (intHorizontal - 1150) / 2
    intTop = (intVertical - 600) / 2
    window.moveTo intLeft, intTop
end sub 
 
Sub menu_onmouseover 
  
  clearmenu 
  with window.event.srcElement 
    if .parentElement.ID = "menu" then 
      .style.border = "thin outset" 
      .style.cursor = "arrow" 
    end if 
  end with 
 
end sub 
 
Sub menu_onmouseout 
 
  with window.event.srcElement 
    .style.border = "none" 
    .style.cursor = "default" 
  end with ' srcElement 
 
end sub 
 
Sub dropmenu_onmouseover 
  
  with window.event 
    .srcElement.style.cursor = "arrow" 
    .cancelbubble = true 
    .returnvalue = false 
  end with 
 
end sub 
 
sub SubMenuOver 
 
  with window.event.srcElement 
    if .ID = "dropmenu" then exit sub 
    .style.backgroundcolor = "darkblue" 
    .style.color = "white" 
    .style.cursor = "arrow" 
  end with 
 
end sub 
 
sub SubMenuOut 
 
  with window.event.srcElement 
    .style.backgroundcolor = "lightgrey" 
    .style.color = "black" 
    .style.cursor = "default" 
  end with 
 
end sub 
 
Sub menu_onclick 
Dim oEL, oItem 
 
  if sMenuOpen <> "" then exit sub 
  with window.event.srcElement 
    if .ID <> "menu" then 
      .style.border = "thin inset" 
      nLeft = .offsetLeft 
      ntop  = .offsetTop + replace(menu.style.Height, "px", "") - 5 
      sMenuOpen = trim(.innertext) 
      with dropmenu 
        with .style 
          .border = "thin outset" 
          .backgroundcolor = "lightgrey" 
          .position = "absolute" 
          .left = nLeft 
          .top = nTop 
          .width = "100px" 
          .zIndex = "101"  
        end with ' style 
        for each sItem in dMenus.Item(sMenuOpen) 
          set oEL = document.createElement("SPAN") 
          .appendChild(oEL) 
          with oEl 
            .ID = sItem 
            .style.height = "20px" 
            .style.width = dropmenu.style.width 
            .style.zIndex = "102" ' added 28 June 2010 
            .innerHTML = Replace(sHTML, "#sItem#", trim(sItem)) 
            set .onmouseover = getRef("SubMenuOver") 
            set .onmouseout = getRef("SubMenuOut") 
            set .onclick = getRef("SubMenuClick") 
            set .onselectstart = getRef("cancelEvent") 
          end with ' child node 
          set oEL = document.createElement("BR") 
          .appendChild(oEL) 
        next 
      end with ' dropmenu 
    end if 
  end with ' srcEement 
 
end sub 
 
sub cancelEvent 
  window.event.returnValue = false 
end sub ' cancelEvent 
 
sub clearmenu 
 
  dropmenu.innerHTML = "" 
  dropmenu.style.border = "none" 
  dropmenu.style.backgroundcolor = "transparent" 
  if sMenuOpen <> "" then 
    document.getElementByID(sMenuOpen).style.border = "none" 
    sMenuOpen = "" 
  end if 
end sub 
 
' ###################  IMPORTANT  ################### 
' Code to accomplish each submenu item defined above 
' Can be as simple as a subroutine call 
' 
Sub SubMenuClick 
 
  sItem = trim(window.event.srcElement.innerText) 
  clearmenu 
  Select Case lcase(sItem) 
    case "open" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "close" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "save" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "save as ..." 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "exit" 
      window.close 
    case "cut" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "copy" 
    case "paste" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "select all" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "deselect all" 
      msgbox "Sorry, " & sItem & " is not implemented"     
    case "help" 
      msgbox "Help under construction", vbOKOnly + vbInformation, "Help" 
    case "about" 
      msgbox "Copyright, 2013" & vbCRLF & "Chris wright"_ 
              & vbCRLF & "Released for Purchasing Only",_ 
              vbOKOnly + vbInformation, "About Menu" 
    case else ' catch all for undefined menu items 
      msgbox "Sorry, " & sItem & " is not implemented" 
  end Select 
 
end sub 
 
Sub RunScript
    Location.Reload(True)
End Sub

Sub LoadDropDown
	Dim Rs, cn, objOption 
  
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSrc & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select Distinct [Vendor Name] from [VPN Position$]", cn, 1, 3

	' add a blank
	Set objOption = Document.createElement("OPTION")
	objOption.Text = ""
	objOption.Value = -1
	OptionChooser.Add(objOption)

    Do Until rs.EOF
	Set objOption = Document.createElement("OPTION")
	objOption.Text = rs.fields("Vendor Name")
	objOption.Value = rs.fields("Vendor Name")
	OptionChooser.Add(objOption)
	rs.MoveNext
    Loop 

End Sub

Sub ClearListbox
    For Each objOption in OptionChooser.Options
       objOption.RemoveNode
    Next
End Sub

Open in new window


scripts/batch.vbs - code to run your batch
Sub BatchRun
	' Uncomment the next line if you are having issues but 
	' it prevents error messages from being displayed
	'On Error Resume Next
	
	Dim WshShell
	Set WshShell = CreateObject("WScript.Shell")
	
	Dim cmd1
	cmd1 = "C:\oracle\discoverer\bin\dis51usr.exe /connect ""crwright:ADS Parts Manager/PASSWORD@DB"" /opendb ""ADS Stocking Position By Vendor"" /parameter ""Supplier_Name"" echo %1 /sheet ALL /export XLS ""\\ads-fs1\ads\Chris Wright\Chris Wright\Daily Reports\Daily Stocking Position.xls"" /batch"
	
	' run and hide the window and wait for execution to finish
	WshShell.Run cmd1, 1, True
	
	Dim cmd2
	cmd2 = "I:\Chris Wright\Chris Wright\Daily Projects\Miscellaneous\Daily Macros\Daily Position Macro-Working File.xlsm"
	
	' run and hide the window and wait for the macro to close the spreadsheet
	WshShell.Run cmd2, 1, True
	
	Set WshShell = Nothing
End Sub

Open in new window

0
 

Author Comment

by:Christopher Wright
ID: 39261501
I was digging around today and found that the Oracle Doscoverer Middlewear that's being used has the ability to export directly to HTML. Maybe this could be of use? Just thought I'd mention it so I could help as best as I could.  Thanks my friend!
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39261506
Much easier!  The batch could wait for it to finish then display the results using the html returned
0
 

Author Comment

by:Christopher Wright
ID: 39264422
I keep getting the error message below when I make changes to the Vendor Name dropdown

Error Msg
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39264665
can you see the batch.vbs file in your scripts folder?
0
 

Author Comment

by:Christopher Wright
ID: 39264847
Yes sir. I have three files in the scripts folder. Batch.vbs is one of those files.
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39264891
I'm assuming it worked for you when I posted it above? That being the case what did you change do you think that made it stop? Can you post the version that isn't working?
0
 

Author Comment

by:Christopher Wright
ID: 39267138
Here are all of the files as requested:
Index.txt
css.zip
scripts.zip
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Author Comment

by:Christopher Wright
ID: 39271082
Happy Monday tagit.  Just wanted to double check to see if had a chance to look at the files I sent.  Again, thank you so much for your help.  I am creating the new question(s) this morning.  Thanks again.
0
 

Author Closing Comment

by:Christopher Wright
ID: 39271824
I am sincerely grateful for all of your help tagit.  You showed a great deal of patience with me and also allowed me to learn a lot in the process.  Thanks for being an expert that served as an online mentor in the process.  God bless you!!
0
 

Author Comment

by:Christopher Wright
ID: 39273227
This question has a follow on question.  Link provided below:

http://www.experts-exchange.com/Database/Oracle/Q_28166003.html
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39276679
I'll take a look though i'm away at the moment so will look when i can :)
0
 

Author Comment

by:Christopher Wright
ID: 39278013
Yes sir.  Not a problem.  I thought I may have made some headway with the code above not working but to no avail. I added 'OPTION EXPLICIT' to the BatchRun code but no luck.  I'm still plugging away at it.  Thanks my friend.
0
 

Author Comment

by:Christopher Wright
ID: 39281089
I was thinking, I do not really need to call cmd2 in the batch.vbs code.  All that does is simply email the formatted report that is generated with cmd 1.  And then, instead of having the batch.vbs called with an on-change in the drop down, I can simply assign it to a button just like we already have the searches.  What are your thoughts?  I may go ahead and post another question concerning having the report exported to html or to xml.  Thanks

Sub BatchRun
  ' Uncomment the next line if issues arise but it prevents error messages from being displayed
	'On Error Resume Next
	
  Dim WshShell
  Set WshShell = CreateObject("WScript.Shell")
	
  Dim cmd1
  cmd1 = "C:\oracle\discoverer\bin\dis51usr.exe /connect ""crwright:ADS Parts Manager/cew5310@prod"" /opendb ""ADS Stocking Position By Vendor"" /parameter ""Supplier_Name""  echo %1  /sheet ALL /export XLS ""\\ads-fs1\ads\Chris Wright\Chris Wright\Daily Reports\Daily Stocking Position.xls"" /batch"
	
  ' run and hide the window and wait for execution to finish
  WshShell.Run cmd1, 1, True
	
  Dim cmd2
  cmd2 = "I:\Chris Wright\Chris Wright\Daily Projects\Miscellaneous\Daily Macros\Daily Position Macro-Working File.xlsm"
	
  ' run and hide the window and wait for the macro to close the spreadsheet
  WshShell.Run cmd2, 1, True
	
  Set WshShell = Nothing

End Sub

Open in new window

0
 

Author Comment

by:Christopher Wright
ID: 39291854
Have you had a chance to take a look at this one yet tagit? Thanks
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39293244
I like the idea of the button, that would work fine. Also sounds sensible to remove the cmd2 as you can have the hta email it if required. Sorry, still on leave, but if I can get to a laptop to view the files I will :)
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39295409
ok! I think i've got to the bottom of this.  I saved your hta file above (had to rename it from .txt to .hta)  When I ran it I had the same issue because windows blocks the program from running properly.

right click on the hta, select properties, then select unblock.

unblock via properties
Alternatively you can unblock if you get the following message by just unticking the box i've indicated in the screenshot

unblock when running
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39295422
I did want to add that you can avoid this by deploying your app via a web browser, rather than an hta.  no files required on the clients computer.  you just give them a link to access?
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39295448
Adding to what i've said it would also mean that the client wouldn't need discoverer installed either.  You have everything in the one place, vbs scripts, css, html etc
0
 

Author Comment

by:Christopher Wright
ID: 39296382
Nice!!! Very impressive.  You stated that you were on leave.  Are you military?  I spent 10 years in the Army until I had an accident and had to retire early.
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39296445
Gathered that worked for you ;)
Not exactly the military....homemaker!
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39296460
My wife is the one on paid leave. We're just on holiday at the moment so don't get much time to look at the pc ;)
0
 

Expert Comment

by:Prema Raju
ID: 40417711
HI all pls its emergency pls guys reply me i have developed a small app to split some 30 lines into 5 lines in each para and need to display it actually i end with in problem while displaying it i gave msgbox finaltext it limits no of lines displayed .. help me out how to display it ?

<html>
<head>
<title>HTA Test</title>
<HTA:APPLICATION 
     ID="objTest" 
     APPLICATIONNAME="HTA Test"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
WINDOWSTATE=normal>
</head>
<SCRIPT LANGUAGE="VBScript">
    Sub TestSub



 ' Read the input
     strText = ScriptArea.Value
     arrLines = Split(strText, vbCrLf)   
        Splitline = TextBox1.Value * 1

 ' Declarations
        Const NUMBER_DIGITS = 2
        BlkCnt = 1
        LineCount = 0
        BlockCount = 0
        DLine = 0
        Dollar = 0
        Finaltext = ""
        text = ""

 ' To count the total number of lines 
       
       For Each strLine in arrLines  
           LineCount = LineCount + 1    
       Next  

 ' To determine number of blocks based on the lines per block
    
       BlockCount = LineCount / Splitline 
       BlockCount = Int(BlockCount)      
       Remainder = LineCount Mod Splitline
       
       If Remainder <> 0 Then
          BlockCount = BlockCount + 1
       End If 
 
 ' Format the block number to modify in the DIR
       
       BlockCount = Hex (BlockCount)
       BlockCount = Right(String(NUMBER_DIGITS, "0") & BlockCount, NUMBER_DIGITS)
       BlkCnt = Right(String(NUMBER_DIGITS, "0") & BlkCnt, NUMBER_DIGITS)
       Replacetext = BlkCnt & BlockCount & "T"

 ' To determine the first occurrence of $
     For Each strLine in arrLines    
            DLine = DLine + 1        
        Dollar = InStr(1,strLine,"$",0)
        Dollar = Dollar - 1  
            If Dollar > 0 Then Exit For           
        Next 

 ' To extract the header till $  
        Scount = 0       
        For Each strLine in arrLines
            Scount = Scount + 1
            If Scount = Dline Then
               text = text & Left(strLine,Dollar)
               text = text & "\" & vbCRLF 
            ElseIf Scount <> Dline  Then
               text= text & strLine & vbCRLF   
            End If
            If Scount = Dline  Then Exit For                 
        Next      
 ' To Split and Insert the header at right place
        Scount = 0
        For Each strLine in arrLines
            Scount = Scount + 1
            If Scount < Splitline Then
               Finaltext = Finaltext & strLine & vbCRLF
               Finaltext= replace(Finaltext,"0101T",Replacetext) 
            ElseIf Scount = Splitline Then
                position = InStrRev(strLine,"\",-1,0)
                position = position - 1
                Finaltext = Finaltext & Left(strLine,position) & vbCRLF
                BlkCnt = BlkCnt + 1  
                BlkCntHex = Hex(BlkCnt)
                BlkCntHex = Right(String(NUMBER_DIGITS, "0") & BlkCntHex, NUMBER_DIGITS)
                Replacetext = BlkCntHex & BlockCount & "T" 
                textdup= replace(text,"0101T",Replacetext)
            ElseIf Scount > Splitline  Then
                Finaltext = Finaltext & textdup  
                Finaltext = Finaltext & strLine & vbCRLF
                Scount = 1 
            End If               
         Next
       Msgbox Finaltext 
      End Sub
</SCRIPT>
<body>
Enter the DIR to Split: <BR><BR>
  <textarea name="ScriptArea" rows=10 cols=90></textarea><p>
Enter the No of lines per block: <BR>
  <input type="text" name="TextBox1" size="2"><BR><BR>

  <input id=runbutton  type="button" value="Split DIR" name="run_button"  
onClick="TestSub">

</body>

Open in new window

0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

You may have already been in the need to update a whole folder stucture using a script. Robocopy does it well and even provides a list of non-updated files in a log (if asked to). Generally those files that were locked by a user or a process by the …
This article discusses four methods for overlaying images in a container on a web page
In this tutorial viewers will learn how add a full-size background image to a webpage using CSS3. Create a new HTML document with an internal stylesheet.: In CSS, define the html element to have a background image. Use a high resolution image.: In t…
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now