Dynamic List Box Question

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Dynamic List Box Question

Logged in as: Guest

arrSession:exec spGetSession 2,2,55402

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> WSH & Client Side VBScript >> Dynamic List Box Question
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1] 2 next > >>

Message

<< Older Topic Newer Topic >>

Dynamic List Box Question - 1/14/2008 8:43:12 PM

patgenn123

Posts: 37
Score: 0
Joined: 1/14/2008
Status: offline

Greetings everyone!

I am very new to HTML/HTA etc. Very new and don't understand it that much yet. It will take me some time.

I am interested in a dynamic list box that pulls info from a text file. After it does that, I would like to be able to "click on an item from the list and then search the text box for a matching item. The text file is tab delimited and has name, address, city state, zip, and phone number and is constantly being added to via the same hta.

I would like to:

a) click on the list box. (The list box only has the person's name)
b) search for the line in the text file
c) Fill in the fields corresponding to the clicked name in the list box

I found this on Microsoft's website and want to know how to modify this and make it work:

   Sub Window_OnLoad
       ForReading = 1
       Set objFSO = CreateObject("Scripting.FileSystemObject")
       Set objFile = objFSO.OpenTextFile _
           ("C:\Documents and Settings\Pat\Desktop\ReadMe.txt", ForReading)
       Do Until objFile.AtEndOfStream
           strLine = objFile.ReadLine
           Set objOption = Document.createElement("OPTION")
           objOption.Text = strLine
           objOption.Value = strLine
           AvailableComputers.Add(objOption)
       Loop
       objFile.Close
   End Sub
</SCRIPT>
<body>
   <select size="20" name="AvailableComputers" style="width:250"></select>
</body>

Keep in mind, I have absolutely no idea what a lot of these things mean. I am starting to get some things, but it will take a while. Also, remember, this is HTA.

Thank You!

Pat

Post #: 1

RE: Dynamic List Box Question - 1/14/2008 9:12:08 PM

ehvbs

Posts: 2077
Score: 50
Joined: 6/22/2005
From: Germany
Status: offline

Hi patgenn123,

could you post

(a) a short sample of your .txt file

(b) complete code or link to the sample

(c) your .hta (to see the "fields corresponding to" the data from the file)

Thanks

ehvbs

(in reply to patgenn123)

Post #: 2

RE: Dynamic List Box Question - 1/14/2008 9:34:53 PM

patgenn123

Posts: 37
Score: 0
Joined: 1/14/2008
Status: offline

Actaully, the text file name is test.tsv.

Thank you for responding ehvbs!

Here is what I gathered from another site.

Sub SaveData
       Set objFSO = CreateObject("Scripting.FileSystemObject")
       If objFSO.FileExists("C:\Scripts\Test.tsv") Then
          Set objFile = objFSO.OpenTextFile("C:\Scripts\Test.tsv", 8)
           strLine = UserName.Value & vbTab & Email.Value & vbTab & _
               Title.Value & vbTab & Country.Value & vbTab & Product.Value & vbTab & DropDown1.Value & vbTab & BasicTextBox.Value & vbTab & BasicTextArea.Value
           objFile.WriteLine strLine
           objFile.Close
       Else
           Set objFile = objFSO.CreateTextFile("C:\Scripts\Test.tsv")
           strLine = UserName.Value & vbTab & Email.Value & vbTab & _
               Title.Value & vbTab & Country.Value & vbTab & Product.Value &vbTab & DropDown1.Value & vbTab & BasicTextBox.Value & vbTab & BasicTextBox.Value
           objFile.WriteLine strLine
           objFile.Close
       End If
   End Sub

In the <body>, I have:

<input type="text" name="Name" size="15"><input type="text" name="Addressl" size="15" ><input type="text" name="City" size="15"><input type="text" name="State" size="15"><input type="text" name="Zip" size="15">
   <input type="button" value="Run Button" onClick="SaveData">

Using a button, clicking the button saves all the imputed field information into a tab delimited file and appends it.

Just need to find out how to click on the list box (of names) and focus on that contact in the text box, "pull" the info from the text box(maybe put into clipboard?) and bring it into the fields. I guess I'm slowly learning....????

Oh yeah! I certainly wouldn't mind having a timer "refresh" the data every 2-5 minutes or so so the list is always updated!

Thanks!

Pat

(in reply to ehvbs)

Post #: 3

RE: Dynamic List Box Question - 1/14/2008 9:36:38 PM

patgenn123

Posts: 37
Score: 0
Joined: 1/14/2008
Status: offline

Short sample is like this:

John Doe 121 Anywhere Street Austin Texas 75709

Tab delimited..

Pat

(in reply to patgenn123)

Post #: 4

RE: Dynamic List Box Question - 1/14/2008 9:39:01 PM

patgenn123

Posts: 37
Score: 0
Joined: 1/14/2008
Status: offline

ehvbs,

I don't know if I want to post the .hta code. It's my very first one and it has a lot of "experimental things in it. Yet, if you do want it, here it is:

<title>HTA Test</title>
<HTA:APPLICATION
    APPLICATIONNAME="HTA Test"
    SCROLL="no"
    SINGLEINSTANCE="yes"
    WINDOWSTATE="normal"
    <HTA:APPLICATION NAVIGABLE = "yes" />
>
</head>
<script language="VBScript">


   Sub Window_Onload
       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 - 700) / 2
       intTop = (intVertical - 600) / 2
       window.resizeTo 800,600
       window.moveTo intLeft, intTop
   End Sub
Sub SaveData
//////////////////Deletes what is in the text file FIRST before adding new information to the tabbed text values////////////////////////
       Const ForWriting = 2
       Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objFile = objFSO.OpenTextFile("C:\Scripts\Test.tsv", ForWriting)
      objFile.Write ""
      objFile.Close
////////////// ends/////////////////
       Set objFSO = CreateObject("Scripting.FileSystemObject")
       If objFSO.FileExists("C:\Scripts\Test.tsv") Then
          Set objFile = objFSO.OpenTextFile("C:\Scripts\Test.tsv", 8)
           strLine = UserName.Value & vbTab & Email.Value & vbTab & _
               Title.Value & vbTab & Country.Value & vbTab & Product.Value & vbTab & DropDown1.Value & vbTab & BasicTextBox.Value & vbTab & BasicTextArea.Value
           objFile.WriteLine strLine
           objFile.Close
       Else
           Set objFile = objFSO.CreateTextFile("C:\Scripts\Test.tsv")
           strLine = UserName.Value & vbTab & Email.Value & vbTab & _
               Title.Value & vbTab & Country.Value & vbTab & Product.Value &vbTab & DropDown1.Value & vbTab & BasicTextBox.Value & vbTab & BasicTextBox.Value
           objFile.WriteLine strLine
           objFile.Close
       End If
   End Sub

Sub SetFullName
       CombinedName.Value = FirstName.Value & " " & LastName.Value
    End Sub

   Sub TestSub
       Msgbox "Testing 1-2-3."
   End Sub
   Sub Window_onLoad
       window.resizeTo 700,600
   End Sub
Sub Runone
        strCopy = DropDown1.Value
        document.parentwindow.clipboardData.SetData "text", strCopy
   End Sub
Sub RunScript
   strCopy = BasicTextArea.Value
   document.parentwindow.clipboardData.SetData "text", strCopy
End Sub
Sub DateDiff
   Set objShell = CreateObject("Wscript.Shell")
   objShell.Run "DateDiff.mxe"
End Sub
Sub RunScript1
   strAnswer = window.prompt("Please enter the domain name.", "fabrikam.com")
   If IsNull(strAnswer) Then
       Msgbox "You clicked the Cancel button"
   Else
       Msgbox "You entered: " & strAnswer
   End If
End Sub
</script>
<body>
<button onclick="DateDiff">Run Date Difference</button> <p>
<a href ="scared.hta">Go to Scared</a>
<body bgcolor="IndianRed">
<textarea name="BasicTextArea" rows="7" cols="45"></textarea>     
<input type="button" value="Copy to Clipboard" name="run_button" onClick="RunScript"><p>
<input type="button" value="Run Script" name="run_button" onClick="TestSub">
<input type="button" value="Run Script" name="run_button" onClick="RunScript1">
   <input type="text" name="BasicTextBox" size="50"><p>
<br>Copy to Clipboard</br>
     <select size="3" name="DropDown1" onChange="Runone">
         <option value="1">Option 1</option>
         <option value="2">Option 2</option>
         <option value="3">Option 3</option>
         <option value="4">Option 4</option>
</select>

<h2>First Name Last Name, Full Name </h2>
<input type="text" name="FirstName" size="15" onChange="SetFullName">
   <input type="text" name="LastName" size="15" onChange="SetFullName">
   <input type="text" name="CombinedName" size="25" readOnly=True> <h1> User name, Text etc.</h1>
<input type="text" name="UserName" size="15"><input type="text" name="Email" size="15" ><input type="text" name="Title" size="15"><input type="text" name="Country" size="15"><input type="text" name="Product" size="15">
   <input type="button" value="Run Button" onClick="SaveData">
   <input type="button" value="Run Button" onClick="DateDiff">
<A HREF="Microsoft'>http://www.microsoft.com/ie/ie40/demos">Microsoft </A> has some wonderful stuff!
</body>
</html>

(in reply to patgenn123)

Post #: 5

RE: Dynamic List Box Question - 1/15/2008 3:55:19 AM

patgenn123

Posts: 37
Score: 0
Joined: 1/14/2008
Status: offline

As one can see, I do not know a lot of code. The first part is a separate HTA than the full code and a lot of this is all jumbled and makes not 100% sense.

Is there a simple way to click a contact on the list box and send it to the clipboard?

I think I can figure it out from there..

Thanks!

Pat

(in reply to patgenn123)

Post #: 6

RE: Dynamic List Box Question - 1/15/2008 5:12:43 AM

Rischip

Posts: 468
Score: 2
Joined: 3/26/2007
Status: offline

It's just my opinion, but I think this would be much shorter code if you look at the file like a database.
Open the text file using ADODB and treat each entry like a recordset.
You could still do a dynamic listbox to jump to an individual record and begin editing it.

< Message edited by Rischip -- 1/15/2008 5:14:28 AM >

_____________________________

Rischip
Author of - The Grim Linker

(in reply to patgenn123)

Post #: 7

RE: Dynamic List Box Question - 1/15/2008 5:17:24 AM

ehvbs

Posts: 2077
Score: 50
Joined: 6/22/2005
From: Germany
Status: offline

Hi patgenn123,

as you are a bit impatient - I can understand that - let's experiment a bit:

given this schema.ini:

this addresslist.txt:

Caution: Field separators are vbTabs!

this .hta:

<html>
<head>
 <hta:application id = "alpocad"
 />
 <title>alpocad</title>
 <meta http-equiv = "content-type" content="text/html; charset=iso-8859-1"/>
 <meta http-equiv = "content-script-type" content = "text/vbscript"/>
 <style type = "text/css">
  .stdBtt
  { width: 80;
  }
  .Meta
  { color: red;
  }
 </style>
 <script language = "VBScript"
         type     = "text/vbscript"
 >
'<![CDATA[

''# Globals / TopLevel Code
' ############################################################################

''= FileSystemObject, in Memory Data
' ============================================================================
Dim goFS   : Set goFS   = CreateObject( "Scripting.FileSystemObject" )
Dim goData : Set goData = Nothing

''= early resize to minimize flicker
' ============================================================================
window.resizeTo 800,600

''# Functions/Subs
' ############################################################################

''= initializes goData, fills SELECT Names
' ============================================================================
Sub initWhenLoaded()
 Set goData = initData()
 Dim sId, objOption
 For Each sId In goData.Keys
    Set objOption = Document.createElement("OPTION")
    objOption.Text  = goData( sId )( 2 )
    objOption.Value =         sId
    Names.Add objOption
 Next
End Sub

''= Nothing to be done yet; goData will be destroyed autmagically
' ============================================================================
Sub exitWhenClosed()
End Sub

''= insert ad hoc tests here
' ============================================================================
Sub doIt()
 MsgBox "What?"
End Sub

''= loads Data from .txt file into dic/arr memory data structure
' ============================================================================
Function initData()
 Dim oRVal : Set oRVal = CreateObject( "Scripting.Dictionary" )
 Dim sCDir : sCDir     = goFS.GetParentFolderName( UnEscape( document.Script.Location.Pathname ) )
 Dim oTS   : Set oTS   = goFS.OpenTextFile( sCDir & "\addresslist.txt" )
 Dim sLine, aFields
 sLine = oTS.ReadLine ' skip header
 Do Until oTS.AtEndOfStream
    sLine   = oTS.ReadLine
    aFields = Split( sLine, vbTab )
    If 4 = UBound( aFields ) Then
       oRVal( aFields( 0 ) ) = aFields
    End If
 Loop
 oTS.Close
 Set oTS = Nothing
 Set initData = oRVal
End Function

''= fills TEXT elements
' ============================================================================
Sub fillTexts()
 If goData Is Nothing Then
    MsgBox "goData Is Nothing in fillTexts()"
 Else
    Dim sId  : sId     = Names.Options( Names.selectedIndex ).Value
    If Not goData.Exists( sId ) Then
       MsgBox "Not goData.Exists( " & sId & " ) in fillTexts()"
    Else
       Dim sFirstName : sFirstName = goData( sId )( 2 )
       Dim sLastName  : sLastName  = goData( sId )( 1 )

FirstName.Value = sFirstName
       LastName.Value  = sLastName
    End If
 End If
End Sub

''= refreshes the HTA page, which includes re-running any Windows_Onload code
' ============================================================================
Sub reloadHTA()
 location.reload True
End Sub

']]>
 </script>
</head>
<body onload = "initWhenLoaded" onulload = "exitWhenClosed">
 <hr />
 <input id = "bttDoIt" class = "StdBtt" type = "BUTTON" value = "doIt" onclick = "doIt"/>
 <hr />
 <select size = "3" name = "Names" onChange = "fillTexts"></select>
 <hr />
 <div>
  <input type = "text" name = "FirstName" size = "15"/>
 </div>
 <div>
  <input type = "text" name = "LastName"  size = "15"/>
 </div>
 <hr />
 <input class = "StdBtt Meta" type = "BUTTON" value = "reload" onclick = "reloadHTA"/>
</body>
</html>

will fill the SELECT from the file and display the names in TEXTs when you select a name
from the SELECT.

I'd have liked to add some explanations, but perhaps that can be done later.

Good luck!

ehvbs

(in reply to patgenn123)

Post #: 8

RE: Dynamic List Box Question - 1/15/2008 5:46:31 AM

patgenn123

Posts: 37
Score: 0
Joined: 1/14/2008
Status: offline

Rischip and ehvbs,

Well I am thankful! Please don't get the impression I am in a hurry to get the answer. It was about 4AM when I first posted and I pieced your initial request together in 3-4 separate posts. Kind of dumb, but I wasn't thinking straight at the time coming back from work.

If I gave you that impression, I am sorry.

At the same time,

THANK YOU BOTH!

Pat

Rischip, what is ADODB? As you can see, I am really undereducated on this stuff!

(in reply to ehvbs)

Post #: 9

RE: Dynamic List Box Question - 1/15/2008 7:36:13 AM

ehvbs

Posts: 2077
Score: 50
Joined: 6/22/2005
From: Germany
Status: offline

Hi patgenn123,

ADO (Active Data Object(s)) is a COM technology to access data from different sources
(Database Management Systems like MS SQLServer Or files based Data Storage engines
(Access, SQLite) Or even simple text files) using (variations of) SQL.

Check whether there is an ado28.chm help file on your computer or use it online;
starting here

http://support.microsoft.com/kb/183606
http://msdn2.microsoft.com/en-us/library/ms810811.aspx

To see it in action, add this .hta

<html>
<head>
 <hta:application id = "alpocdb"
 />
 <title>alpocdb</title>
 <meta http-equiv = "content-type" content="text/html; charset=iso-8859-1"/>
 <meta http-equiv = "content-script-type" content = "text/vbscript"/>
 <style type = "text/css">
  .stdBtt
  { width: 80;
  }
  .Meta
  { color: red;
  }
 </style>
 <script language = "VBScript"
         type     = "text/vbscript"
 >
'<![CDATA[

Option Explicit

''# Globals / TopLevel Code
' ############################################################################

''= FileSystemObject, DataBase Connection
' ============================================================================
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
Dim goCN : Set goCN = Nothing

''= early resize to minimize flicker
' ============================================================================
window.resizeTo 800,600

''# Functions/Subs
' ############################################################################

''= connects to DataBase, fills SELECT Names
' ============================================================================
Sub initWhenLoaded()
 Set goCN = connectDB()

Dim sSQL : sSQL    = "SELECT LastName, Id FROM [addresslist.txt] ORDER BY LastName"
            sSQL    = "SELECT LastName, Id FROM [addresslist.txt] WHERE LastName = 'doe'"
            sSQL    = "SELECT LastName, Id FROM [addresslist.txt] WHERE FirstName = 'john'"
 Dim oRS  : Set oRS = goCN.Execute( sSQL )
 Dim objOption
 Do Until oRS.EOF
    Set objOption = Document.createElement("OPTION")
    objOption.Text  =       oRS.Fields( 0 ).Value
    objOption.Value = CStr( oRS.Fields( 1 ).Value )
    Names.Add objOption
    oRS.MoveNext
 Loop
 oRS.Close
End Sub

''= disconnects from the DataBase
' ============================================================================
Sub exitWhenClosed()
 If goCN Is Nothing Then
    MsgBox "goCN Is Nothing in exitWhenClosed()"
 Else
    goCN.Close
    Set goCN = Nothing
 End If
End Sub

''= demonstrates UPDATE problem
' ============================================================================
Sub doIt()
 If goCN Is Nothing Then
    MsgBox "goCN Is Nothing in doIt()"
 Else
    Dim sSQL : sSQL    = "UPDATE [addresslist.txt] SET LastName = 'ehvbs' WHERE Id = 1"
On Error Resume Next
    goCN.Execute sSQL
    If 0 = Err.Number Then
       MsgBox "Surprise: UPDATE works in doIt()"
    Else
       MsgBox Err.Number & " " & Err.Description
    End If
On Error GoTo 0
 End If
End Sub

''= connects to DataBase
' ============================================================================
Function connectDB()
 Dim oRVal : Set oRVal = CreateObject( "ADODB.Connection" )
 Dim sCDir : sCDir     = goFS.GetParentFolderName( UnEscape( document.Script.Location.Pathname ) )
 Dim sCS   : sCS       = Join( Array( _
                            "Provider=MSDASQL.1" _
                        , "Driver={Microsoft Text Driver (*.txt; *.csv)}" _
                        , "DBQ=" & sCDir _
                                    ), ";" )
 oRVal.Open sCS
 Set connectDB = oRVal
End Function

''= fills TEXT elements from DB record found via Id/Names SELECT
' ============================================================================
Sub fillTexts()
 MsgBox "Don't know how to get data!"
 Dim sFirstName : sFirstName = "FN " & Timer()
 Dim sLastName  : sLastName  = "LN " & Timer()

FirstName.Value = sFirstName
 LastName.Value  = sLastName
End Sub

Sub fillTexts()
 If goCN Is Nothing Then
    MsgBox "goCN Is Nothing in fillTexts()"
 Else
    Dim nId  : nId     = 2
    Dim sSQL : sSQL    = "SELECT Id, LastName, FirstName FROM [addresslist.txt] WHERE Id = " & nId
    Dim oRS  : Set oRS = goCN.Execute( sSQL )
    If oRS.EOF Then
       MsgBox "oRS.EOF in fillTexts()"
    Else
       Dim sFirstName : sFirstName = oRS.Fields( "FirstName" ).Value
       Dim sLastName  : sLastName  = oRS.Fields( "LastName"  ).Value

FirstName.Value = sFirstName
       LastName.Value  = sLastName
    End If
 End If
End Sub

Sub fillTexts()
 If goCN Is Nothing Then
    MsgBox "goCN Is Nothing in fillTexts()"
 Else
    Dim nId  : nId     = CLng( Names.Options( Names.selectedIndex ).Value )
    Dim sSQL : sSQL    = "SELECT Id, LastName, FirstName FROM [addresslist.txt] WHERE Id = " & nId
    Dim oRS  : Set oRS = goCN.Execute( sSQL )
    If oRS.EOF Then
       MsgBox "oRS.EOF in fillTexts()"
    Else
       Dim sFirstName : sFirstName = oRS.Fields( "FirstName" ).Value
       Dim sLastName  : sLastName  = oRS.Fields( "LastName"  ).Value

FirstName.Value = sFirstName
       LastName.Value  = sLastName
    End If
 End If
End Sub

']]>
 </script>
</head>
<body onload = "initWhenLoaded" onulload = "exitWhenClosed">
 <hr />
 <input id = "bttDoIt" class = "StdBtt" type = "BUTTON" value = "doIt" onclick = "doIt">
 <hr />
 <select size = "3" name = "Names" onChange = "fillTexts"></select>
 <hr />
 <div>
  <input type = "text" name = "FirstName" size = "15">
 </div>
 <div>
  <input type = "text" name = "LastName"  size = "15">
 </div>
 <hr />
 <input class = "StdBtt Meta" type = "BUTTON" value = "reload" onclick = "reloadHTA">
</body>
</html>

to the files I posted a little while ago. It will do the same as the array/dictionary based .hta.
The interesting point is to compare those .hta to see the common structure.

[Hi Rischip - if you are minded to do this - would you still say that database code will
be shorter?]

Both .HTAs are grown out of this template:

<html>
<head>
 <hta:application id = "tmplate"
 />
 <title>tmplate</title>
 <meta http-equiv = "content-type" content="text/html; charset=iso-8859-1"/>
 <meta http-equiv = "content-script-type" content = "text/vbscript"/>
 <style type = "text/css">
  .stdBtt
  { width: 80;
  }
  .Meta
  { color: red;
  }
 </style>
 <script language = "VBScript"
         type     = "text/vbscript"
 >
'<![CDATA[

Option Explicit

''# Globals / TopLevel Code
' ############################################################################

''= early resize to minimize flicker
' ============================================================================
MsgBox "About to resize"
window.resizeTo 800,600

''# Functions/Subs
' ############################################################################

''= just show we can handle the body's onLoad
' ============================================================================
Sub initWhenLoaded()
 MsgBox "Page loaded, ready to run."
End Sub

''= just show we can handle the body's onUnLoad
' ============================================================================
Sub exitWhenClosed()
 MsgBox "Page closed, byebye."
End Sub

''= just show we can handle a button click even
' ============================================================================
Sub doIt()
 MsgBox CStr( document.getElementById( "btDoIt" ) Is Nothing )
End Sub

You (patgenn123) should start your code review with this file; the others are easier to analyse
if you start simple).

I know, I should publish my explanations, but they aren't ready yet - shame on me!

See you (with a bit of luck: soon)

ehvbs

(in reply to patgenn123)

Post #: 10

RE: Dynamic List Box Question - 1/15/2008 8:18:08 AM

Rischip

Posts: 468
Score: 2
Joined: 3/26/2007
Status: offline

Are the headers in the text file?
i.e.

FirstName    LastName    Street    City
John    Doe    121 Anywhere Street    Austin Texas 75709

or is it just the data?

i.e.

John    Doe    121 Anywhere Street    Austin Texas 75709

_____________________________

Rischip
Author of - The Grim Linker

(in reply to patgenn123)

Post #: 11

RE: Dynamic List Box Question - 1/15/2008 8:21:39 AM

ehvbs

Posts: 2077
Score: 50
Joined: 6/22/2005
From: Germany
Status: offline

The whole shebang is designed for

ColNameHeader=True

(as posted)

(in reply to Rischip)

Post #: 12

RE: Dynamic List Box Question - 1/15/2008 5:41:53 PM

Rischip

Posts: 468
Score: 2
Joined: 3/26/2007
Status: offline

Here is an option it uses an activex control Microsotft Tabular Data Control.
The only problem with using this method is when updates are saved the whole file is overwritten.
Also there is no list box as of yet, but this is a Work In Progress.
So it should only be used by one person at a time.
This problem can be overcome with some additional code, but this version is exclusive use only. All changes are done in memory until the Save To File button is pressed.
Total Code = 98 lines including empty lines

<HTML>
<HEAD><TITLE>Check This Out</TITLE>
<STYLE>
.ItemLabel {font-weight:bold}
</STYLE>
</HEAD>
<BODY><BR><BLOCKQUOTE>
<FONT FACE="VERDANA,ARIAL,HELVETICA" SIZE="2">
<H2>OK, So I cheated a Little</H2>
<div style="display:none">
<OBJECT classid="clsid:333C7BC4-460F-11D0-BC04-0080C7055A83"
 ID=tdcPerson HEIGHT=0 WIDTH=0>
<PARAM NAME="DataURL" VALUE="test.txt">
<PARAM NAME="UseHeader" VALUE="True">
<PARAM NAME="FieldDelim" VALUE="&#09;">
</OBJECT>
</div>
<BR>
<TABLE>
<TR><TD NOWRAP CLASS=ItemLabel>First Name</td><td><input type=text DATASRC=#tdcPerson DATAFLD="FirstName"></input></TD></TR>
<TR><TD CLASS=ItemLabel>Last Name</td><td><input type=text DATASRC=#tdcPerson DATAFLD="LastName"></input></TD></TR>
<TR><TD CLASS=ItemLabel>Street</td><td><input type=text DATASRC=#tdcPerson DATAFLD="Street"></input></TD></TR>
<TR><TD CLASS=ItemLabel>City</td><td><input type=text DATASRC=#tdcPerson DATAFLD="City"></input></TD></TR>
<TR><TD CLASS=ItemLabel>State</td><td><input type=text DATASRC=#tdcPerson DATAFLD="State"></input></TD></TR>
<TR><TD VALIGN=top CLASS=ItemLabel>ZipCode</td><td><input type=text DATASRC=#tdcPerson DATAFLD="ZipCode"></input></TD></TR>
</TABLE>
<BR>
<BR>
<INPUT ID=cmdNavFirst TYPE=BUTTON VALUE="<<" 
 onclick="tdcPerson.recordset.MoveFirst()">
<INPUT ID=cmdNavPrev TYPE=BUTTON VALUE="<" STYLE="width:20px"
 onclick="tdcPerson.recordset.MovePrevious(); if (tdcPerson.recordset.BOF)tdcPerson.recordset.MoveFirst();">
<INPUT ID=cmdNavNext TYPE=BUTTON VALUE=">" STYLE="width:20px" 
 onclick="tdcPerson.recordset.MoveNext(); if(tdcPerson.recordset.EOF)tdcPerson.recordset.MoveLast();">
<INPUT ID=cmdNavLast TYPE=BUTTON VALUE=">>" 
 onclick="tdcPerson.recordset.MoveLast()">
<INPUT ID=cmdNew TYPE=BUTTON VALUE="New" 
 onclick="tdcPerson.recordset.AddNew()">
<INPUT ID=cmdNew TYPE=BUTTON VALUE="Delete" 
 onclick="tdcPerson.recordset.Delete()">
<INPUT ID=cmdSaveToFile TYPE=BUTTON VALUE="Save To File" 
 onclick="SaveToFile()">
<script language="VBScript">
Sub SaveToFile
Dim oFSO 
Dim oTSTemp

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set TSTemp = oFSO.CreateTextFile("test.txt", True, True)

for i = 0 to tdcPerson.recordset.Fields.Count -1
if i>0 then text = text & vbtab
text = text & tdcPerson.recordset.Fields.item(i).name

next
text = text & vbcrlf
tdcPerson.recordset.movefirst

do until tdcPerson.recordset.EOF

for i = 0 to tdcPerson.recordset.Fields.Count -1

if i>0 then text = text & vbtab

text = text & tdcPerson.recordset.Fields.item(i).value

next
text = text & vbcrlf
tdcPerson.recordset.movenext
Loop
tdcPerson.recordset.movelast

TSTemp.Write text

End Sub
</script>
</DIV>
</BODY>
</HTML>

test.txt [data file used for the example tab delimited]

< Message edited by Rischip -- 1/15/2008 5:49:51 PM >

_____________________________

Rischip
Author of - The Grim Linker

(in reply to ehvbs)

Post #: 13

RE: Dynamic List Box Question - 1/16/2008 2:05:00 AM

ehvbs

Posts: 2077
Score: 50
Joined: 6/22/2005
From: Germany
Status: offline

Hi Rischip,

I did some terrible things to your code:

What I did to Rischips Script
=============================================================================
( 1) Explicit .HTA
( 2) layout/look and feel => CSS
( 3) deleted the secret/hidden Javascript (Pfui!) code
( 4) corrected some typos like cmdNew instead of cmdDelete or oTSTemp
    instead of TSTemp
( 5) some cosmetic changes (">>" ==> ">|")
( 6) moved all script code to header
( 7) started to make SaveToFile reusable (parameter/no reliance on globals)
    and fit for the lazy programmer who likes others to roll his loops
    for him
( 8) Implemented just goTop and goNext as samples; too stressed to do all
    or make the button status change good
( 9) add a listbox to please patgenn123; I copied HTML/VBScript code from
    my sample(s). But what I did is a hack - to do it properly you have
    to use the Tabular Data Control

and came up with this:

<html>
<head>
 <hta:application id     = "rischip02"
                  scroll = "no"
 />
 <title>Check This Out</title>
 <meta http-equiv = "content-type" content="text/html; charset=iso-8859-1"/>
 <meta http-equiv = "content-script-type" content = "text/vbscript"/>
 <style type = "text/css">
  body
  { background-color: lightblue;
    font-family: Verdana, Geneva, Arial, Helvetica, sans-serif;
    font-size: 140%
  }
  .stdBtt
  { width: 80;
  }
  .Meta
  { color: red;
  }
  .ItemLabel
  { font-weight:bold
  }
 </style>
 <script language = "VBScript"
         type     = "text/vbscript"
 >
'<![CDATA[

Option Explicit

''# Globals / TopLevel Code
' ############################################################################

''= early resize to minimize flicker
' ============================================================================
window.resizeTo 800,600

''# Functions/Subs
' ############################################################################

''=
' ============================================================================
Sub initWhenLoaded()
 Set goData = initData()
 Dim sId, objOption
 For Each sId In goData.Keys
    Set objOption = Document.createElement("OPTION")
    objOption.Text  = goData( sId )( 1 )
    objOption.Value =         sId
    Names.Add objOption
 Next
End Sub

''= loads Data from .txt file into dic/arr memory data structure
' ============================================================================
Function initData()
 Const ForReading =  1 ' can't work with the defaults anymore
 Const FFUnicode  = -1 ' *I* won't rely on True == -1 in 2008
 Dim oRVal : Set oRVal = CreateObject( "Scripting.Dictionary" )
 Dim sCDir : sCDir     = goFS.GetParentFolderName( UnEscape( document.Script.Location.Pathname ) )
 Dim oTS   : Set oTS   = goFS.OpenTextFile( sCDir & "\test.txt", ForReading, False, FFUnicode )  ' changed name, encoding
 Dim nId   : nId       = 1
 Dim sLine, aFields
 sLine = oTS.ReadLine ' skip header
 Do Until oTS.AtEndOfStream
    sLine   = oTS.ReadLine
    aFields = Split( sLine, vbTab )
    If 5 = UBound( aFields ) Then  ' 6 fields, but alas no Id
       oRVal( CStr( nId ) ) = aFields
       nId                  = nId + 1
    End If
 Loop
 oTS.Close
 Set oTS = Nothing
 Set initData = oRVal
End Function

''= fills TEXT elements
' ============================================================================
Sub fillTexts()
 If goData Is Nothing Then
    MsgBox "goData Is Nothing in fillTexts()"
 Else
    Dim sId  : sId     = Names.Options( Names.selectedIndex ).Value
    If Not goData.Exists( sId ) Then
       MsgBox "Not goData.Exists( " & sId & " ) in fillTexts()"
    Else
'       Had to be done from scratch; *** terrible hack, study TDC ***
       Dim nIdx : nIdx = CLng( sId ) - 1
       tdcPerson.recordset.moveFirst
       Do Until 0 = nIdx
          tdcPerson.recordset.moveNext
          nIdx = nIdx - 1
       Loop
    End If
 End If
End Sub

''=
' ============================================================================
Sub exitWhenClosed()
End Sub

''= saves to file
''  SaveToFile_00: Rischips code reformatted & made ready for Option Explicit
''  SaveToFile_01: let the Recordset do the work for us, use parameters to reuse code
''  *** for testing I save to test2.txt! **********
' ============================================================================
Sub SaveToFile
' select the version of current interest
' SaveToFile_00
 SaveToFile_01 tdcPerson.recordset, "test2.txt"
End Sub

Sub SaveToFile_00
 Dim oFSO    : Set oFSO    = CreateObject( "Scripting.FileSystemObject" )
 Dim oTSTemp : Set oTSTemp = oFSO.CreateTextFile( "test2.txt", True, True )
 Dim text    : text        = ""
 Dim i
 For i = 0 to tdcPerson.recordset.Fields.Count - 1
     If i > 0 Then text = text & vbtab
     text = text & tdcPerson.recordset.Fields.item( i ).name
 Next
 text = text & vbcrlf
 tdcPerson.recordset.movefirst
 Do Until tdcPerson.recordset.EOF
    For i = 0 to tdcPerson.recordset.Fields.Count - 1
        if i > 0 Then text = text & vbtab
        text = text & tdcPerson.recordset.Fields.item( i ).value
    Next
    text = text & vbcrlf
    tdcPerson.recordset.movenext
 Loop
 tdcPerson.recordset.movelast
 oTSTemp.Write text
End Sub

Sub SaveToFile_01( oRS, sFSpec )
 Const adClipString = 2 ' to keep ADO happy
 Dim oFSO    : Set oFSO    = CreateObject( "Scripting.FileSystemObject" )
 Dim oTSTemp : Set oTSTemp = oFSO.CreateTextFile( sFSpec, True, True )
 Dim nIdx    : nIdx        = 0
 ReDim aFldNs( oRS.Fields.Count - 1 )
 Dim oFld
 For Each oFld In oRS.Fields
     aFldNs( nIdx ) = oFld.Name
     nIdx           = nIdx + 1
 Next
 With oRS
   .movefirst
   If Not .EOF Then
      oTSTemp.Write   Join( aFldNs, vbTab ) _
                    & vbCrLf _
                    & .GetString( adClipString, , vbTab, vbCrLf, "" )
      oTSTemp.Close
      .movefirst
   End If
 End With
End Sub

''= move top for arbitrary objects of class "clsid:333C7BC4-460F-11D0-BC04-0080C7055A83"
''= whatever they called in human speech
' ============================================================================
Sub goTop( oDStore, oBtt )
' If Not oDStore Is a "clsid:333C7BC4-460F-11D0-BC04-0080C7055A83" Then Exit Sub
' If Not oBtt    Is a "BUTTON"                                     Then Exit Sub
 oX.recordset.MoveFirst
' oBtt could be disabled, as long as we enable it after other movements
End Sub

''= move top for arbitrary objects of class "clsid:333C7BC4-460F-11D0-BC04-0080C7055A83"
''= whatever they called in human speech
' ============================================================================
Sub goTop( oDStore, oBtt )
' If Not oDStore Is a "clsid:333C7BC4-460F-11D0-BC04-0080C7055A83" Then Exit Sub
' If Not oBtt    Is a "BUTTON"                                     Then Exit Sub
 oDStore.recordset.MoveFirst
' oBtt could be disabled, as long as we enable it after other movements
End Sub

''= move next for arbitrary objects of class "clsid:333C7BC4-460F-11D0-BC04-0080C7055A83"
''= see above for possible enhancements; i just color the button here to show I can
''= access it
' ============================================================================
Sub goNext( oDStore, oBtt )
 If oDStore.recordset.EOF Then
    oBtt.style.color = "yellow"
 Else
    oBtt.style.color = "black"
    oDStore.recordset.MoveNext
 End If
End Sub

']]>
 </script>
</head>
<body onload = "initWhenLoaded" onunload = "exitWhenClosed">
 <hr />
 <input id = "bttDoIt" class = "StdBtt" type = "BUTTON" value = "doIt" onclick = "doIt"/>
 <hr />
 <ok>OK, So I cheated a Little</h2>
 <div style="display:none">
  <OBJECT classid="clsid:333C7BC4-460F-11D0-BC04-0080C7055A83"
          ID="tdcPerson" HEIGHT="0" WIDTH="0"
  />
   <PARAM NAME="DataURL" VALUE="test.txt">
   <PARAM NAME="UseHeader" VALUE="True">
   <PARAM NAME="FieldDelim" VALUE="&#09;">
  </OBJECT>
 </div>
 <TABLE>
  <TR><TD NOWRAP CLASS=ItemLabel>First Name</td><td><input type=text DATASRC=#tdcPerson DATAFLD="FirstName"></input></TD></TR>
  <TR><TD CLASS=ItemLabel>Last Name</td><td><input type=text DATASRC=#tdcPerson DATAFLD="LastName"></input></TD></TR>
  <TR><TD CLASS=ItemLabel>Street</td><td><input type=text DATASRC=#tdcPerson DATAFLD="Street"></input></TD></TR>
  <TR><TD CLASS=ItemLabel>City</td><td><input type=text DATASRC=#tdcPerson DATAFLD="City"></input></TD></TR>
  <TR><TD CLASS=ItemLabel>State</td><td><input type=text DATASRC=#tdcPerson DATAFLD="State"></input></TD></TR>
  <TR><TD VALIGN=top CLASS=ItemLabel>ZipCode</td><td><input type=text DATASRC=#tdcPerson DATAFLD="ZipCode"></input></TD></TR>
 </TABLE>
 <hr />
 <INPUT ID="cmdNavFirst"   class = "StdBtt" TYPE="BUTTON" VALUE="|<"     onclick="goTop tdcPerson, Me">
 <INPUT ID="cmdNavPrev"    class = "StdBtt" TYPE="BUTTON" VALUE="<"      onclick="">
 <INPUT ID="cmdNavNext"    class = "StdBtt" TYPE="BUTTON" VALUE=">"      onclick="goNext tdcPerson, Me">
 <INPUT ID="cmdNavLast"    class = "StdBtt" TYPE="BUTTON" VALUE=">|"     onclick="">
 <INPUT ID="cmdNew"        class = "StdBtt" TYPE="BUTTON" VALUE="New"    onclick="">
 <INPUT ID="cmdDelete"     class = "StdBtt" TYPE="BUTTON" VALUE="Delete" onclick="">
 <INPUT ID="cmdSaveToFile" class = "StdBtt" TYPE="BUTTON" VALUE="Save"   onclick="SaveToFile">
 <hr />
 <select size = "6" name = "Names" onChange = "fillTexts"></select>
 <hr />
 <input class = "StdBtt Meta" type = "BUTTON" value = "reload" onclick = "reloadHTA"/>
</body>
</html>

I know, I should have worked on my explanations, but this was more fun.

Thank you for the inspiring script. There is more than one way to do it as there is more than
one middle road between "so much red tape and rules that no work ist done" on the left
and "utter chaos but working" on the right. I hope you'll agree that going left of you or
right of me is ok in both cases.

Regards

ehvbs

(in reply to Rischip)

Post #: 14

RE: Dynamic List Box Question - 1/16/2008 2:51:05 AM

Rischip

Posts: 468
Score: 2
Joined: 3/26/2007
Status: offline

I'm fine with any changes I adapted this code from Microsoft's website.
I will reference the page once I find it again.

_____________________________

Rischip