Question

寻找一种改善在Excel中的用户窗体上填充VBA列表框的性能的方法。我创建了一个函数以连接到SQL数据库，查询所需的数据，并创建一个记录集，然后遍历该记录集以填充ListBox。查询和数据检索本身似乎很快，而缓慢似乎是填充ListBox控件的方法。我尝试了2种方法，目前使用数组，因为它速度稍快。

在ListBox中仅填充50行需要13-14秒。太久了。

Function GetComments(intRFQ_ID As Integer) As Integer

Dim dbCmnd As ADODB.Command
Dim dbConn As ADODB.Connection
Dim rstSQLquery As ADODB.Recordset
Set dbCmnd = New ADODB.Command
Set dbConn = New ADODB.Connection

AA_SQL_Vars
dbConn.ConnectionString = "driver={SQL Server};server=" & strDBserver & ";uid=" & strDBuser & ";pwd=" & strDBpass & ";database=" & strDBname
dbConn.Open

frmCommentsView.ListBox1.Clear
ListCnt = 0
RmkCnt = 0
strSQLSelect = ""
strSQLSelect = strSQLSelect & "SELECT [Created],[Comments],[Created_By] "
strSQLSelect = strSQLSelect & "FROM [dbPricing].[dbo].[tblRFQ_Comments] "
strSQLSelect = strSQLSelect & "Where [RFQ_ID] = '" & intRFQ_ID & "'"
strSQLSelect = strSQLSelect & "Order by [Created]"
Set rstSQLquery = New ADODB.Recordset
rstSQLquery.Open strSQLSelect, dbConn, adOpenStatic, adLockReadOnly, adCmdText

'This is slightly faster
lngRecords = rstSQLquery.RecordCount
If lngRecords > 0 Then
    ReDim strRecords(lngRecords - 1, 3)
    While Not rstSQLquery.EOF
        RmkCnt = RmkCnt + 1
            strRecords(ListCnt, 0) = Format(rstSQLquery.Fields("Created").Value, "YYMMDD HHMM")
            strRecords(ListCnt, 1) = Trim(rstSQLquery.Fields("Comments").Value)
            strRecords(ListCnt, 2) = Trim(rstSQLquery.Fields("Created_By").Value)
        ListCnt = ListCnt + 1
        rstSQLquery.MoveNext
    Wend
    frmCommentsView.ListBox1.List() = strRecords
Else
    frmCommentsView.ListBox1.Clear
End If

'' WHY IS THIS SO SLOW????
'While (Not (rstSQLquery.EOF))
'    RmkCnt = RmkCnt + 1
'    frmCommentsView.ListBox1.AddItem
'    If IsNull(Trim(rstSQLquery.Fields("Created").Value)) Then
'    Else
'        frmCommentsView.ListBox1.List(ListCnt, 0) = Format(Trim(rstSQLquery.Fields("Created").Value), "YYMMDD HHMM")
'    End If
'    If IsNull(Trim(rstSQLquery.Fields("Comments").Value)) Then
'    Else
'        frmCommentsView.ListBox1.List(ListCnt, 1) = Trim(rstSQLquery.Fields("Comments").Value)
'    End If
'    If IsNull(Trim(rstSQLquery.Fields("Created_By").Value)) Then
'    Else
'        frmCommentsView.ListBox1.List(ListCnt, 2) = Trim(rstSQLquery.Fields("Created_By").Value)
'    End If
'    rstSQLquery.MoveNext
'    ListCnt = ListCnt + 1
'Wend

rstSQLquery.Close

GetComments = RmkCnt

dbConn.Close
Set rstSQLquery = Nothing
Set dbConn = Nothing

End Function

提高填充VBA ListBox的速度

0 个答案: