将数据从SQL加载到HTA中的列表框VBscript

问题描述

我有一个HTA（html应用程序），它从SQL查询中接收数据，但是当我尝试将结果粘贴到列表框中时，它仅给出最后一条记录。

Dim connect,sql,resultSet,pth,txt
Set connect = CreateObject("ADODB.Connection")
    connect.ConnectionString = "Driver={sql Server};Server=XXX;Database=XXX;trusted_connection=True;" 
    connect.Open

sql = "SELECT [Var0],[Var1],[Var2],[Var3],[Var4],[Var5] FROM [XXX].[dbo].[Table]"
sql = sql & " WHERE [Var3]='" & FieldUser.value & "' and [Var0]='" & YEAR(Date()) & "-" & RIGHT("00"&MONTH(Date()),2) & "-" & RIGHT("00"&DAY(Date()),2) & "'"
sql = sql & " ORDER BY [Var0] desc,[Var1] desc"

Set resultSet = connect.Execute(sql)

On Error Resume Next
resultSet.MoveFirst
Do until resultSet.eof 

objOption3.Text = ""

if resultSet(0) <> "" then 

    'msgBox(resultSet(0) & " ~ " & resultSet(1) & " ~ " & resultSet(2) & " ~ " & resultSet(3) & " ~ " & resultSet(4) & " ~ " & resultSet(5))
    objOption3.Text = resultSet(1) & " ~ " & resultSet(3)
    objOption3.Value = resultSet(0) & ";" & resultSet(1) & ";" & resultSet(2) 
    RegListView.Add (objOption3)
end if

  resultSet.MoveNext
Loop


resultSet.Close
connect.Close
Set connect = nothing

当我取消注释MsgBox时，我可以看到找到了所有记录，但是它仅输出最后一条记录（似乎正确地查询了该查询，但是仅在连接关闭时才执行Add操作？）

如何使它在列表框中输入所有记录？

我尝试更改添加行而不成功-我更改为：

document.all.RegListView.add(objOption3)

我也试图将resultSet输出为数组-我可以使msgBox正确显示数组中的记录，但未将其添加到列表框中-也许有人可以通过这种方式帮助我解决问题？

在连接内部：

dim dbarray
dbarray = resultSet.getrows

关闭连接后：

for i=1 to 100

    objOption3.Text = ""
    objOption3.Value = ""
    
if dbarray(0,i) <> "" then
    msgBox (dbarray(1,i) & " ~ " & dbarray(3,i))
    objOption3.Text = dbarray(1,i)
    objOption3.Value = dbarray(0,i) & ";" & dbarray(1,i) & ";" & dbarray(2,i) 
    RegListView.Add (objOption3)
end if
next

我真的希望有所帮助：）

已添加：这是HTA的HTML正文：

<body>

<table style="width:100%">
<h1>OpgaveTid for <span id="TextUser"></span><span style="padding-left:90px"><input type="button" value="Mindre" id="SendBtnMinimer" style="width: 50px;" onclick="vbscript:Minimeropgavetid()"/></h1>


<tr>
<td>
<label for="FieldSearchOrg">Search Org:</label><br>
<input type="text" id="FieldSearchOrg" name="FieldSearchOrg" onchange="vbscript:FuncSearchOrg()" tabindex="1" size=8>
<input type="button" value="Save" id="SendBtn" onclick="vbscript:SaveAction()" tabindex="3"/>
<input type="button" value="Part" id="SendBtn" onclick="vbscript:SavePartAction()" tabindex="4"/>
<input type="hidden" id="FieldOrgText" name="FieldOrgText" readonly="yes">
<input type="hidden" id="FieldUser" name="FieldUser" readonly="yes">
<input type="hidden" id="FieldUserGroup" name="FieldUserGroup" readonly="yes">
</td>
<td>

</td>
</tr>
<tr>
<td>
<label for="OrgListView">Orglist:</label><br>
<select size="28" name="OrgListView" style="width:160" multiple="no" onchange="vbscript:FuncSelectOrg()" tabindex="2"></select><br><br>
<label for="RegListView">My registrations:  (Tryk F5 for at opdatere)</label><br>
<select size="14" name="RegListView" style="width:160" multiple="no" onchange="vbscript:FuncSelectHistReg()"></select><br><br>
<input type="button" value="Edit registration" id="UpdateReg" style="width: 150px;" onclick="vbscript:UpdateReg()"/>
<input type="button" value="Delete registration" id="DeleteReg" style="width: 150px;" onclick="vbscript:DeleteReg()"/><br><br>
</td>
<td>

</td>
</tr>
</table>
</body>

解决方法

大多数情况下，当您显示一个集合中的项目时，仅显示最后一个项目，这可能是因为项目被覆盖，并且在循环之后仅显示了最后一个项目。

在您的代码中，项目（objOption）在循环之外定义，然后将文本和值分配给同一对象，并添加到循环内的select中，最后显示最后一个选项。接下来出现的错误会被错误恢复恢复抑制。

只需在循环内创建选项，然后分配属性并添加

Do until resultSet.eof 

    if resultSet(0) <> "" then 
        Set objOption = Document.createElement("option")
        objOption.Text = resultSet(1) & " ~ " & resultSet(3)
        objOption.Value = resultSet(0) & ";" & resultSet(1) & ";" & resultSet(2) 
        RegListView.Add (objOption)
    end if

    resultSet.MoveNext
Loop

我解决了这个问题……这确实不是最好的解决方案，但是它解决了问题。

欢迎提出任何改进建议。

    Set objOption4 = Document.createElement("OPTION")
Dim connect,sql,resultSet,pth,txt

dim dbarray

Set connect = CreateObject("ADODB.Connection")
    connect.ConnectionString = "Driver={SQL Server};Server=XXX;Database=XXX;trusted_connection=True;" 
    connect.Open

sql = "SELECT [Var0],[Var1],[Var2],[Var3],[Var4],[Var5] FROM [XXX].[dbo].[Table]"
sql = sql & " WHERE [Var3]='" & FieldUser.value & "' and [Var0]='" & YEAR(Date()) & "-" & RIGHT("00"&MONTH(Date()),2) & "-" & RIGHT("00"&DAY(Date()),2) & "'"
sql = sql & " ORDER BY [Var0] desc,[Var1] desc"

Set resultSet = connect.Execute(sql)

dbarray = resultSet.getrows

'On Error Resume Next
resultSet.MoveFirst
Do until resultSet.eof 

objOption4.Text = ""

if resultSet(0) <> "" then 

    'msgbox(resultSet(0) & " ~ " & resultSet(1) & " ~ " & resultSet(2) & " ~ " & resultSet(3) & " ~ " & resultSet(4) & " ~ " & resultSet(5))
    objOption4.Text = resultSet(1) & " ~ " & resultSet(3)
    objOption4.Value = resultSet(0) & ";" & resultSet(1) & ";" & resultSet(2) 
    'RegListView.Add(objOption4)
    'document.all.RegListView.add(objOption4)
end if

  resultSet.MoveNext
Loop


resultSet.Close
connect.Close
Set connect = Nothing

通过使用我在连接内部创建的数组，我在数组和列表框上运行了2个循环以添加记录

for i=1 to 100
  objOption4.Text = ""
  objOption4.Value = ""   
if dbarray(1,i) <> "" and dbarray(3,i) <> "LOGON" then
  'msgbox (dbarray(1,i) & " ~ " & dbarray(3,i))
  objOption4.Text = dbarray(1,i)
  objOption4.Value = dbarray(0,i) & ";" & dbarray(1,i) & ";" & dbarray(2,i) 
  objOption4.id = i
  if objOption4.Value <> "" then

      j=0
      k=0
      For Each o In Document.getElementById("RegListView").Options
          if k=0 then
              if o.text = "" Then
                  j=j+1
                  'MsgBox o.Text
                  o.text = objOption4.Text
                  o.value = objOption4.Value
                  k=1
              End if
          End if
      Next

      'msgbox (objOption4.Value)
      RegListView.Add(objOption4),0+i
  end if
end if
next

adodb hta listbox sql sql vbscript vbscript vbscript