Creating multi-select list box in VBScript [closed] - vbscript

Question

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I want to create a VBScript (not within an HTML file) that gives the user a list of documents to select from then uses the selections to run another script for each document they chose. How do I create this list box?

Answer 1

Some sort of GUI for WSH VBS can be implemented via dynamically created HTA window. The below code includes two wrapper classes, which facilitate HTA window creation and elements events handling, and shows how to put a listbox and buttons on the form and get selected items:
Option Explicit
' Base64-encoded background image
Const BGI = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAWIAAAB2CAYAAADybJlDAAAACXBIWXMAAC4jAAAuIwF4pT92AAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1MAAA6mAAADqYAAAXb5JfxUYAAAUjSURBVHja7N05ztxGEIBRjqHciZ34Bn3/w9QNnPsE49QwtPwc9lLd9V4kAdKwyQE+Fjnb6/1+XwCs85tDACDEAEIMgBADCDEAQgwgxAAIMYAQAyDEAEIMgBADCDEAQgwgxACM980hgD28Xq/Td7Hd/PdxzHPri+FBiBPH9hPbBVqIQYh3D+/2YRZiEOIT47tVmIUYhLhCfFMHWYhBiKsFOF2UhRiEuHKAUwRZiEGIBXhxkIUYhFiAFwdZiEGIBXhxjIUYhDhLhCP5OocFWYhBiGeHLaxdiEGI54YsNljj0n0SYhDiEYGLhGtKG2MhBiHOFuCdXiDsEmMhhtoh7hW9SLKOLWMsxFA3xD3iVznA3Y6FEEPNED8NoAB3PC5CDPVCvDLCFT4gcvv4CDHUCvGTEFYKcMw8Vn48FOpYEeG28RQ87cRjIoYaE/GnMdxpCo7O2336eH9f1/WPEIMQr4jwyo8Zt4HbaqOOoRCDEGePcCzc9pQYCzGcHeJZER45ia6ewmP0MfViHZxrxwjHle9XltvoYyTEIMIZIvwkwDNvvfT6/0IMpInw0wn4SYTj4Xa63T4RYjANr4hwj1sQKybhIc+NEIMIz4xwr3vAvSI8eyo2EQNLAphhGo1Ej92EGESyW0AWhbD3fkaHbT86lkIMNc2KcO+3ox3500lCDPWm4ZkRXjnx31lDTDgeP3wcIYZaEZ712Bk+lBG7bFOIoZbYdBsz3g0SC/a/CTGw6lZAlok/xZqEGGrFsg163FW3AnqvY8lULMQg3pkj3JKsYyghhjrT8KhL66oRbr3WI8Qg5OUm0Gz7JMQgxhmDdcoJ4UvrEmKoF9AfPVbbdN+2n8qFGNg5fkfcGhFiIFP82mb72Ho8lhDD+dOrqdxEDCyc6mLAY54+lQsxkDrspvwBx06IQUDtj4kYGDA5xnf+Hpvv07GEGEzHd4LZO5qVXqALIQZ6xaxtuu602xNiYNV03A46FkIM7BuhpNPwVEIM50VvxddBjvqC+hKEGAQ9++PG6U+IEAOzp+M7wS7xHmghBnaajk3EgEA+nI4rT8NCDNy+hO4VQtPxL3xzCIAvTKWz3zOcYRr+a9ZaTcSA2wTf9/usDQkxcCfGMWk7pQgx1PGHUAoxsNafHUM7ajouGXkhBjKFc8RXbQoxUCLGgizEgCB33+60KwIhBgR5ceB9oAPYNWTHvLBnIoa9Js2el9UnRPmIfRViYNol+CZBnh53tyaAE+O/1ScAhRgQ5cWEGBgZwa9OlW3SeqLj2rsdF/eIQQxXif/9OSYdlx73lLuuVYhhL9kvs3sELiau9b9RXnbyEmIg6wln5kln6U84CTGcK/Ptibjx72ZHefpz4cU6YJfwx6Tt3NnPLicIIYY9L9vb5us/Icg/W8OtfRRiOH9KPfXL1mPiND706kCIgenhKRblX/JiHdS5vM/wpUGzPnq81Qt8Qgym1dNPWOmjLMRQayquHPq0URZiMBVXO3GYiIEtYnjy7Yxs+xZCDDXCOipAuwW7fXB8h0/y3r4GZDthZIrwz9bfeh0XIYYzIvfVKNyJx0kfBmmDjnuXbbk1AZzukwjHhG2FEINL/4xTZpUIm4hBjKfGdtXtjZZ4WyHEwOk+jfCSk4YQg6k402S5Y4Tb0+0IMTAyPpF0XWkiLMRgKj5lKn7yy8yx+pgIMYhxlel8dYRDiEGMT5uK23VAhIUYqDgFp4rwdV3X6/1+e0phA6/Xa7dJ9rT3NQ+7B/0vAAAA//8DAERsQ7O6796eAAAAAElFTkSuQmCC"
Dim aItems, i
' Array containing items for ListBox
aItems = Array("Item A", "Item B", "Item C", "Item D", "Item E")
' Create HTA window wrapper
With New clsSmallWrapperForm
' Setup window
.ShowInTaskbar = "yes"
.Title = "Test HTA UserForm"
.BackgroundImage = BGI
.Width = 354
.Height = 118
.Visible = False
' Create window
.Create
' Assign handlers
Set .Handlers = New clsSmallWrapperHandlers
' Add ListBox
With .AddElement("ListBox1", "SELECT")
.size = 6
.multiple = True
.style.left = "15px"
.style.top = "10px"
.style.width = "250px"
End With
.AppendTo "Form"
' Add ListBox items
For i = 0 To UBound(aItems)
.AddElement , "OPTION"
.AddText aItems(i)
.AppendTo "ListBox1"
Next
' Add OK Button
With .AddElement("Button1", "INPUT")
.type = "button"
.value = "OK"
.style.left = "285px"
.style.top = "10px"
.style.width = "50px"
.style.height = "20px"
End With
.AppendTo "Form"
' Add Cancel Button
With .AddElement("Button2", "INPUT")
.type = "button"
.value = "Cancel"
.style.left = "285px"
.style.top = "40px"
.style.width = "50px"
.style.height = "20px"
End With
.AppendTo "Form"
' Add Label
With .AddElement("Label1", "SPAN")
.style.left = "15px"
.style.top = "98px"
.style.width = "350px"
End With
.AddText "Choose items"
.AppendTo "Form"
' Show window
.Visible = True
' Wait window closing or user choise
Do While .ChkDoc And Not .Handlers.Selected
WScript.Sleep 100
Loop
' Read results from array .Handlers.SelectedItems
If .Handlers.Selected Then
MsgBox "Selected " & (UBound(.Handlers.SelectedItems) + 1) & " Item(s)" & vbCrLf & Join(.Handlers.SelectedItems, vbCrLf)
Else
MsgBox "Window closed"
End If
' The rest part of code ...
End With
Class clsSmallWrapperHandlers
' Handlers class implements events processing
' Edit code to provide the necessary behavior
' Keep conventional VB handlers names: Public Sub <ElementID>_<EventName>()
Public oswForm ' mandatory property
Public Selected
Public SelectedItems
Private Sub Class_Initialize()
Selected = False
SelectedItems = Array()
End Sub
Public Sub ListBox1_Click()
Dim vItem
With CreateObject("Scripting.Dictionary")
For Each vItem In oswForm.Window.ListBox1.childNodes
If vItem.Selected Then .Item(vItem.innerText) = ""
Next
SelectedItems = .Keys()
End With
oswForm.Window.Label1.style.color = "buttontext"
oswForm.Window.Label1.innerText = (UBound(SelectedItems) + 1) & " selected"
End Sub
Public Sub Button1_Click()
Selected = UBound(SelectedItems) >= 0
If Selected Then
oswForm.Window.close
Else
oswForm.Window.Label1.style.color = "darkred"
oswForm.Window.Label1.innerText = "Choose at least 1 item"
End If
End Sub
Public Sub Button2_Click()
oswForm.Window.close
End Sub
End Class
Class clsSmallWrapperForm
' Utility class for HTA window functionality
' Do not modify
' HTA tag properties
Public Border ' thick | dialog | none | thin
Public BorderStyle ' normal | complex | raised | static | sunken
Public Caption ' yes | no
Public ContextMenu ' yes | no
Public Icon ' path
Public InnerBorder ' yes | no
Public MinimizeButton ' yes | no
Public MaximizeButton ' yes | no
Public Scroll ' yes | no | auto
Public Selection ' yes | no
Public ShowInTaskbar ' yes | no
Public SysMenu ' yes | no
Public WindowState ' normal | minimize | maximize
' Form properties
Public Title
Public BackgroundImage
Public Width
Public Height
Public Left
Public Top
Public Self
Dim oWnd
Dim oDoc
Dim bVisible
Dim oswHandlers
Dim oLastCreated
Private Sub Class_Initialize()
Set Self = Me
Set oswHandlers = Nothing
Border = "thin"
ContextMenu = "no"
InnerBorder = "no"
MaximizeButton = "no"
Scroll = "no"
Selection = "no"
End Sub
Private Sub Class_Terminate()
On Error Resume Next
oWnd.Close
End Sub
Public Sub Create()
' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
Dim sName, sAttrs, sSignature, oShellWnd, oProc
sAttrs = ""
For Each sName In Array("Border", "Caption", "ContextMenu", "MaximizeButton", "Scroll", "Selection", "ShowInTaskbar", "Icon", "InnerBorder", "BorderStyle", "SysMenu", "WindowState", "MinimizeButton")
If Eval(sName) <> "" Then sAttrs = sAttrs & " " & sName & "=" & Eval(sName)
Next
If Len(sAttrs) >= 240 Then Err.Raise 450, "<HTA:APPLICATION" & sAttrs & " />"
sSignature = Mid(Replace(CreateObject("Scriptlet.TypeLib").Guid, "-", ""), 2, 16)
Set oProc = CreateObject("WScript.Shell").Exec("mshta ""about:<script>moveTo(-32000,-32000);document.title='*'</script><hta:application" & sAttrs & " /><object id='s' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>s.putProperty('" & sSignature & "',document.parentWindow);</script>""")
Do
If oProc.Status > 0 Then Err.Raise 507, "mshta.exe"
For Each oShellWnd In CreateObject("Shell.Application").Windows
On Error Resume Next
Set oWnd = oShellWnd.GetProperty(sSignature)
If Err.Number = 0 Then
On Error Goto 0
With oWnd
Set oDoc = .document
With .document
.open
.close
.title = Title
.getElementsByTagName("head")(0).appendChild .createElement("style")
.styleSheets(0).cssText = "* {font:8pt tahoma;position:absolute;}"
.getElementsByTagName("body")(0).id = "Form"
End With
.Form.style.background = "buttonface"
If BackgroundImage <> "" Then
.Form.style.backgroundRepeat = "no-repeat"
.Form.style.backgroundImage = "url(" & BackgroundImage & ")"
End If
If IsEmpty(Width) Then Width = .Form.offsetWidth
If IsEmpty(Height) Then Height = .Form.offsetHeight
.resizeTo .screen.availWidth, .screen.availHeight
.resizeTo Width + .screen.availWidth - .Form.offsetWidth, Height + .screen.availHeight - .Form.offsetHeight
If IsEmpty(Left) Then Left = CInt((.screen.availWidth - Width) / 2)
If IsEmpty(Top) Then Top = CInt((.screen.availHeight - Height) / 2)
bVisible = IsEmpty(bVisible) Or bVisible
Visible = bVisible
.execScript "var smallWrapperThunks = (function(){" &_
"var thunks,elements={};return {" &_
"parseHandlers:function(h){" &_
"thunks=h;for(var key in thunks){var p=key.toLowerCase().split('_');if(p.length==2){elements[p[0]]=elements[p[0]]||{};elements[p[0]][p[1]]=key;}}}," &_
"forwardEvents:function(e){" &_
"if(elements[e.id.toLowerCase()]){for(var key in e){if(key.search('on')==0){var q=elements[e.id.toLowerCase()][key.slice(2)];if(q){eval(e.id+'.'+key+'=function(){thunks.'+q+'()}')}}}}}}})()"
If Not oswHandlers Is Nothing Then
.smallWrapperThunks.parseHandlers oswHandlers
.smallWrapperThunks.forwardEvents .Form
End If
End With
Exit Sub
End If
On Error Goto 0
Next
WScript.Sleep 100
Loop
End Sub
Public Property Get Handlers()
Set Handlers = oswHandlers
End Property
Public Property Set Handlers(oHandlers)
Dim oElement
If Not oswHandlers Is Nothing Then Set oswHandlers.oswForm = Nothing
Set oswHandlers = oHandlers
Set oswHandlers.oswForm = Me
If ChkDoc Then
oWnd.smallWrapperThunks.parseHandlers oswHandlers
For Each oElement In oDoc.all
If oElement.id <> "" Then oWnd.smallWrapperThunks.forwardEvents oElement
Next
End If
End Property
Public Sub ForwardEvents(oElement)
If ChkDoc Then oWnd.smallWrapperThunks.forwardEvents oElement
End Sub
Public Function AddElement(sId, sTagName)
Set oLastCreated = oDoc.createElement(sTagName)
If VarType(sId) <> vbError Then
If Not(IsNull(sId) Or IsEmpty(sId)) Then oLastCreated.id = sId
End If
oLastCreated.style.position = "absolute"
Set AddElement = oLastCreated
End Function
Public Function AppendTo(vNode)
If Not IsObject(vNode) Then Set vNode = oDoc.getElementById(vNode)
vNode.appendChild oLastCreated
ForwardEvents oLastCreated
Set AppendTo = oLastCreated
End Function
Public Function AddText(sText)
oLastCreated.appendChild oDoc.createTextNode(sText)
End Function
Public Property Get Window()
Set Window = oWnd
End Property
Public Property Get Document()
Set Document = oDoc
End Property
Public Property Get Visible()
Visible = bVisible
End Property
Public Property Let Visible(bWindowVisible)
bVisible = bWindowVisible
If ChkDoc Then
If bVisible Then
oWnd.moveTo Left, Top
Else
oWnd.moveTo -32000, -32000
End If
End If
End Property
Public Function ChkDoc()
On Error Resume Next
ChkDoc = CBool(TypeName(oDoc) = "HTMLDocument")
End Function
End Class
In fact that is just a draft, and some operations like generic types elements creation can be simplified by adding wrappers and methods with such functionality to clsSmallWrapperForm.