HTA / VBScript /accdb：从 db 获取多行时遇到问题答案

【问题标题】：HTA / VBScript /accdb: trouble with getting multiple rows from dbHTA / VBScript /accdb：从 db 获取多行时遇到问题
【发布时间】：2022-01-20 16:57:50
【问题描述】：

我目前正在开发一个函数，将我的访问数据库中的一些值放入一些列（在我的代码中称为“插槽”）。

fillSlot()函数存在问题，SQL查询由函数dbCall()执行

当我尝试创建 Flakes 要求的输出时，我像这样更改了我的代码，它现在至少做了一些事情。使用的函数：dbCall 从我的数据库中获取数据，fillSlot 使用该数据，createSlots 创建插槽并在每个插槽调用一次 fillSlot。

function dbCall(dbQuery, iAmount)
    
    Dim sConnectionString, objConnection, objRecordset, lTemp
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    Set objRecordset = CreateObject("ADODB.Recordset")
    sConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & localDB
    objCommand.ActiveConnection = sConnectionString
    
    'do DB-Stuff
    objCommand.CommandText = dbQuery
    objCommand.CommandType = 1
    set objRecordset = objCommand.Execute
    Select Case iAmount
        Case -1
            'unknown amount of results
            set lTemp = objRecordset.fields
            set dbCall = lTemp
        Case 0
            'zero results - for update-queries
            dbCall = 0
        Case 1
            'exactly one result
            lTemp = objRecordset.fields(0)
        
            dbCall = lTemp
    End Select
End function

function fillSlot(iSlot)
    Dim lUsers, oSlot, iCount, tid, tFirstname, tLastname, tSlot
    
    'dbQuery = "UPDATE users SET active = 1, slot = " & iSlot & " WHERE LDAPName = 'aaadmin'"
    'dbCall dbQuery, 0
    dbQuery = "SELECT LDAPName, Vorname, Nachname FROM users WHERE active > 0 AND slot = " &iSlot & " ORDER BY Vorname"
    Set lUsers = dbCall(dbQuery, -1)
    iCount = 0
    
    tSlot = "Slot" & iSlot
    Set oSlot = document.GetElementByID(tSlot)
    For Each field in lUsers
        If iCount < 0 Then
            iCount = 0
        End If
        Select Case iCount
            Case 0
                Set NewNode = document.CreateElement("div")
                If field = "aaadmin" Then
                    NewNode.setAttribute "ID", "dummy" & iSlot
                Else
                    NewNode.setAttribute "ID", field
                End If
            Case 1
                NewNode.innerHTML = field
            Case 2
                NewNode.innerHTML = NewNode.innerHTML & " " & field
                oSlot.appendChild(NewNode)
                iCount = -1
        End Select
        iCount = iCount + 1
    Next
End function

function createSlots()
    'fills main
    iSlotCount = getSlotAmount() 'currently returns 5
    iWidth = 72 / iSlotCount
    iWidth = round(iWidth)
    sWidth = "width: " & iWidth & "%;"
    iSlot = 0
    
    'create Slots 1 to n with n = iSlotCount
    while iSlot <= iSlotCount       
        If iSlot > 0 Then
            iSlotSize = getSlotSize(iSlot) 'maximum amount of users in this slot
        End If
        iSlotUsers = getUserInSlot(iSlot)
        iSlotName = getSlotName(iSlot) 'basically returns "slot" & iSlot
        Set NewNode = document.CreateElement("div")
        NewNode.setAttribute "ID", "Slot" & iSlot
        If iSlot = 0 Then
            NewNode.setAttribute "class", "content NoSlot"
        Else
            NewNode.setAttribute "class", "content slot"
            NewNode.setAttribute "style", sWidth
        End If
        slots.appendChild(NewNode) 'add new slot
        
        Set NewChild = document.CreateElement("span")
        NewChild.setAttribute "ID", "UsersIn" & iSlot
        NewChild.innerHTML = iSlotUsers
        If iSlot > 0 Then
            NewChild.innerHTML = NewChild.innerHTML & " / " & iSlotSize
        End If
        NewChild.innerHTML = NewChild.innerHTML & "<br>"
        NewNode.appendChild(NewChild) 'add title to slot
        
        sButtonText = "diesen Pausenslot wählen (Alt + " & iSlot & ")" 'mouseover-text for button
        Set NewChild = document.CreateElement("button")
        NewChild.setAttribute "class", "button"
        NewChild.setAttribute "ID", "btn" & iSlot
        NewChild.setAttribute "accesskey", iSlot
        NewChild.setAttribute "title", sButtonText
        NewChild.setAttribute "disabled" 'changed in another function (tbd)
        NewChild.setAttribute "onClick", "claimSlot(" & iSlot &")"
        NewChild.innerHTML = iSlotName
        NewNode.appendChild(NewChild) 'adds a button to move own account into this slot
        'add users that are already in this slot
        fillSlot(iSlot)
        iSlot = iSlot + 1
    wend
End function

数据库：

LDAPName (str)	Vorname (str)	Nachname (str)	active (int)	slot (int)
aaadmin	admin	admin	0	0
dummy0	dummy	dummy	1	0
dummy1	first	dummy	1	0
dummy2	second	dummy	0	1
dummy3	third	dummy	1	2
dummy4	forth	dummy	1	3
dummy5	fifth	dummy	1	4
dummy6	sixth	dummy	1	5

此代码的作用：它生成 6 个 ID 为 0 到 5 的插槽，向每个插槽添加一个按钮以更改自己的帐户所在的插槽（按钮代码未包含在本文中）并加载每个活跃的用户(active > 0) 并且在槽 iSlot 中（这是 createSlots 主循环的索引）。

问题：这只会添加一个用户。每个插槽都包含一个带有 innerHTML = "admin admin" 的 div。 dummy-accounts dummy0 到 dummy6 根本没有添加。

编辑：我只是将 2 行设置为 active = 0（见上文），当使用 iSlot = 1 调用 fillSlots 时，导致“发生异常错误”（实际上是“Ausnahmefehler aufgetreten”，由 Google 翻译）

【问题讨论】：

如果您删除选择案例并按照相同的顺序执行案例中所做的事情会发生什么？
每次循环运行的变量“field”都有不同的内容。所以第一次字段是 LDAPName，第二次是名字，第三次是用户的姓氏。如果没有这种情况，我会生成一个 id=LDAPName 和 innerHTML =“LDAPName DAPName”的 div，第二次是 ID=firstname 和 innerHTML =“Firstname Firstname”，第三次是 ID=Lastname 和 innerHTML =“Lastname Lastname”
试过了，如果没有情况，它实际上会为每个插槽添加 3 个条目（每个 LDAPName、Firstname 和 Lastname 一个条目），所以我可以遍历我的结果，我需要找到另一种方法.. .
@Flakes 感谢您的提示，至少我现在还有另一个问题：-D
@Flakes 我刚刚添加了第三个函数和数据库（表的每一行当前确实存在与我的数据库中的完全一样；只是删除了由于 active = 而没有返回的不必要的列和帐户0），这是否回答了您关于我的代码的问题？并且：我试图返回整个记录集，但无法正常工作。我该怎么做？这可能会有很大帮助。

标签： ms-access vbscript hta

【解决方案1】：

像这样重写代码：

function dbCall(dbQuery, iAmount)
    
    Dim sConnectionString, objConnection, objRecordset, lTemp
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    Set objRecordset = CreateObject("ADODB.Recordset")
    sConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & localDB
    objCommand.ActiveConnection = sConnectionString
    
    'dbQuery = dbQuery & ";"
    
    'do DB-Stuff
    'objConnection.open sConnectionString
    'objRecordset.Open dbQuery, objConnection
    objCommand.CommandText = dbQuery
    objCommand.CommandType = 1
    set objRecordset = objCommand.Execute
    Select Case iAmount
        Case -1
            'unbekannte Anzahl, Liste definieren und als ganzes zurückgeben
            set lTemp = objRecordset
            'objRecordset.close
            'objConnection.close
            set dbCall = lTemp
        Case 0
            'kein Rückgabewert - für Update und Insert-Calls
            'objRecordset.close
            'objConnection.close
            dbCall = 0
        Case 1
            'genau ein Rückgabewert - Standardfall
            lTemp = objRecordset.fields(0)
        
            'objRecordset.close
            'objConnection.close
            dbCall = lTemp
    End Select
End function

function fillSlot(iSlot)
    Dim lUsers, oSlot, tid, tFirstname, tLastname, tSlot
    
    dbQuery = "SELECT LDAPName, Vorname, Nachname FROM users WHERE active > 0 AND slot = " &iSlot & " ORDER BY Vorname"
    Set lUsers = dbCall(dbQuery, -1)
    
    tSlot = "Slot" & iSlot
    Set oSlot = document.GetElementByID(tSlot)
    Do While not lUsers.EOF
        Set NewNode = document.CreateElement("div")
        NewNode.setAttribute "ID", lUsers.Fields.Item("LDAPName").Value
        NewNode.innerHTML = lUsers.Fields.Item("Vorname").Value & " " & lUsers.Fields.Item("Nachname").Value
        oSlot.appendChild(NewNode)
        lUsers.moveNext
    Loop
End function

其实我在dbCall中改了一行，完全重写了fillSlot。我不知道上次尝试这样做时发生了什么，这次成功了。每个活跃用户都会在插槽中列出，如果插槽中没有人列出，则不会出错，这似乎按预期工作。

【讨论】：

解释：我的问题中的代码确实传输了第一个数据集的字段，这就是为什么除了第一个用户之外的每个用户都被丢弃了。通过返回整个记录集，我可以使用所有数据集。