'***********************************
'函数名:updatelistview
'参数: LSV : listview
' SQL: SQL语句
'返回: 根据SQL语句的执行结果向Listview 中添加记录
'
'完成时间: 2001-05-06
'制作人: 黄浩
'20035-12 添加返回值 Boolean
'************************************
Function UpdateListviewADO(Lsv As Object, ByVal SQl As String) As Boolean
Dim Rs As Recordset '动态数据集
Dim i As Integer
Dim intCols As Integer '列表头数
Dim ItemX As ListItem
Dim X As Single
Set Rs = New Recordset
On Error GoTo Errdebug
'执行SQL语句
Rs.Open SQl, Rn, adOpenStatic, adLockPessimistic, adAsyncFetch
'取得列表头数
intCols = Rs.Fields.Count
'清空列表
Lsv.ColumnHeaders.Clear
Lsv.ListItems.Clear
'添加表头
Lsv.View = 1
For i = 1 To intCols
If intCols > 6 Then
Lsv.ColumnHeaders.Add , , Rs.Fields.Item(i - 1).Name, 1200
Else
Lsv.ColumnHeaders.Add , , Rs.Fields.Item(i - 1).Name, 1200
End If
Next i
Lsv.View = lvwReport
'添加数据
On Error GoTo Errdebug
While Not Rs.EOF
'判断是否空值
If IsNull(Rs.Fields(0)) Then
Set ItemX = Lsv.ListItems. _
Add(, , "")
Else
Set ItemX = Lsv.ListItems. _
Add(, , CStr(Rs.Fields(0)))
End If
'添加记录集
For i = 1 To intCols - 1
Select Case Rs.Fields(i).Type
Case 5
If IsNull(Rs.Fields(i)) Then
X = 0
Else
X = Rs.Fields(i)
End If
ItemX.SubItems(i) = Format(X, "#0.00")
Case 11
If Rs.Fields(i) = True Then
ItemX.SubItems(i) = "是"
Else
ItemX.SubItems(i) = "否"
End If
Case Else
If IsNull(Rs.Fields(i)) Then
ItemX.SubItems(i) = ""
Else
ItemX.SubItems(i) = Rs.Fields(i)
End If
End Select
Next i
Rs.MoveNext
Wend
Rs.Close
Set Rs = Nothing
UpdateListviewADO = True
Exit Function
Errdebug:
MsgBox "错误发生在刷新列表中,错误为" & Err.Description
On Error GoTo 0
UpdateListviewADO = False
End Function