Link to home
Start Free TrialLog in
Avatar of Christopher Wright
Christopher WrightFlag for United States of America

asked on

Help With HTA

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

Avatar of Rob
Rob
Flag of Australia image

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
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?
Avatar of Christopher Wright

ASKER

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!!!
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
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!!
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
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.
ASKER CERTIFIED SOLUTION
Avatar of Rob
Rob
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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!
Much easier!  The batch could wait for it to finish then display the results using the html returned
I keep getting the error message below when I make changes to the Vendor Name dropdown

User generated image
can you see the batch.vbs file in your scripts folder?
Yes sir. I have three files in the scripts folder. Batch.vbs is one of those files.
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?
Here are all of the files as requested:
Index.txt
css.zip
scripts.zip
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.
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!!
This question has a follow on question.  Link provided below:

https://www.experts-exchange.com/questions/28166003/User-Friendly-Reporting-Tool.html
I'll take a look though i'm away at the moment so will look when i can :)
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.
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

Have you had a chance to take a look at this one yet tagit? Thanks
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 :)
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.

User generated image
Alternatively you can unblock if you get the following message by just unticking the box i've indicated in the screenshot

User generated image
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?
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
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.
Gathered that worked for you ;)
Not exactly the military....homemaker!
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 ;)
Avatar of Prema Raju
Prema Raju

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