VBScriptで複数選択リストボックスを作成する

Question

選択するドキュメントのリストをユーザーに提供するVBScript（HTMLファイルではありません）を作成し、選択したドキュメントを使用して選択したドキュメントごとに別のスクリプトを実行します。私はVBScriptで作業して以来、長い時間が経ちました...このリストボックスを作成するにはどうすればいいですか？

クリス

Answer 1

WSH VBSのためのGUIのいくつかの並べ替えが動的に作成HTAウィンドウを介して実施することができます。以下のコードは、HTAウィンドウの作成と要素のイベントは、取り扱いを容易2つのラッパークラスを含み、およびフォーム上のリストボックスとボタンを入れて、選択した項目を取得する方法を示しています。

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 

ちょうどドラフトで実際には、汎用タイプの要素作成のようないくつかの操作は、clsSmallWrapperFormにそのような機能を持つラッパーとメソッドを追加することで簡単にできます。