鉴于大家对VB十分关注，我们编辑小组在此为大家搜集整理了“VB6 ADO ListView数据库分页显示”一文，供大家参考学习!
Dimlink1AsNewADODB.Connection
DimrsAsNewADODB.Recordset
DimpageAsInteger
DimpubdatapathAsString
Subopendatabase(datapathAsString)''打开数据库函数
page=1''首次定义打开时的页码为1
Iflink1.State=1Then''如果以连接过，则关闭，初始化下次事务
link1.Close:list2.ListItems.Clear:list2.ColumnHeaders.Clear:c.Clear:list1.ListItems.Clear
EndIf
link1.ConnectionString="Provider=microsoft.jet.oledb.4.0;datasource="&datapath
link1.Open
pubdatapath=datapath
Setbiaoming=link1.OpenSchema(adSchemaColumns)''创建数据库记录集
tablename=""
DoUntilbiaoming.EOF
Ifbiaoming("table_name")<>tablenameThen''列出所有表
tablename=biaoming("table_name")
list1.ListItems.Add,,tablename
EndIf
biaoming.MoveNext
Loop
Setbiaoming=Nothing
menu1.Enabled=True
list1_MouseUp1,0,10,10
EndSub
PrivateSubCommand1_Click()''打开数据库
d.DialogTitle="打开一个数据库文件进行浏览"
d.InitDir=App.Path
d.FileName=""
d.Filter="Access数据库(mdb后缀,推荐格式) *.mdb"
d.ShowOpen
Ifd.FileName=""ThenExitSub
opendatabased.FileName
EndSub
PrivateSubCommand4_Click()
str1=InputBox("请输入一个1-5000之间的数字","重设",Text1.Text)
Ifstr1=Text1.TextOrstr1=""ThenExitSub
IfIsNumeric(str1)=FalseThenExitSub
Ifstr1>5000Orstr1<1ThenExitSub
Text1.Text=str1
Iflist1.ListItems.Count=0ThenExitSubElselist1_MouseUp1,0,10,10
EndSub
PrivateSubdown_Click()''功能，下一页
page=page 1:list1_MouseUp1,0,10,10
EndSub
PrivateSubfindstr_Click()''查询数据
IfInStr(Text2.Text,"''")<>0ThenMsgBox"查询时关键字不允许包含''符号",vbCritical,"无效字符":ExitSub
Ifrs.State=1Thenrs.Close
rs.Open"select"&c.Text&"from"&list1.SelectedItem.Text&"where"&c.Text&"like''"&Text2.Text&"''",
link1,adOpenStatic,adLockReadOnly
Ifrs.EOFThenMsgBox"没有符号条件的记录,请从新查找",vbCritical,"未发现记录":ExitSub
DoWhileNotrs.EOF
i=i 1
str1=str1&i&"："&rs(0)&vbCrLf
rs.MoveNext
Loop
MsgBoxstr1,vbExclamation,"查询结果-"&rs.RecordCount&"匹配"
EndSub
PrivateSubForm_Resize()
list1.ColumnHeaders(1).Width=list1.Width-80
list2.Width=Me.ScaleWidth-list2.Left-30
list1.Height=Me.ScaleHeight-list1.Top-30
list2.Height=Me.ScaleHeight-(Me.ScaleHeight-down.Top)-150
EndSub
PrivateSubForm_Unload(CancelAsInteger)
Ifrs.State=1Thenrs.Close
Iflink1.State=1Thenlink1.Close
Setrs=Nothing:Setlink1=Nothing
EndSub
PrivateSublist1_MouseUp(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)''切换表
OnErrorResumeNext
Iflist1.ListItems.Count=0ThenExitSub
Ifrs.State=1Thenrs.Close
list2.ListItems.Clear:list2.ColumnHeaders.Clear:c.Clear
rs.Open"select*from"&list1.SelectedItem.Text,link1,adOpenStatic,adLockReadOnly
IfErr.Number<>0Then
MsgBox"该数据表不能支持的游标模式",vbCritical,"不规则的格式":ExitSub
EndIf
rs.PageSize=Text1.Text
rslen=rs.RecordCount
Ifrs.PageCount<pageThenpage=1
Label3.Caption="共"&rslen&"条记录,共"&rs.PageCount&"页,当前页码"&page
Ifrs.PageCount>pageThendown.Enabled=TrueElsedown.Enabled=False
Ifpage<>1Thenup.Enabled=TrueElseup.Enabled=False
Setziduan=rs.Fields''定义字段记录集
Fori=0Toziduan.Count-1
list2.ColumnHeaders.Add,,ziduan(i).Name''根据字段指定视图列
c.AddItemziduan(i).Name
rs.MoveFirst''记录到尾后填充下一列
rs.AbsolutePage=page''定义记录集的绝对页码
Forr=0Tors.PageSize-1
Ifrs.EOFThenExitFor
rstext=rs(i)
Ifi=0Then''首次直接填充第一列
list2.ListItems.Add,,rstext
Else''非首次填充下一下
Ifrstext<>EmptyThenlist2.ListItems(r 1).ListSubItems.Add,,rstextElselist2.ListItems(r 1).ListSubItems.Add,,""
EndIf
rs.MoveNext
Next
Next
Ifc.ListCount<>0Thenc.ListIndex=0:findstr.Enabled=TrueElsefindstr.Enabled=False
Setziduan=Nothing
EndSub
PrivateSubmenu01_Click(IndexAsInteger)
SelectCaseIndex
Case1:''建新表演示
str1=1
Fori=1Tolist1.ListItems.Count
IfInStr(list1.ListItems(i).Text,"新建表")=1Thenstr1=str1 1
Next
link1.Execute"createtable新建表"&str1&"(会员名Text,密码Varchar(8),年龄intnotnull,经验值"&_
"integer,加入日期DateTimenull)"
link1.Execute"insertinto新建表"&str1&"(会员名,密码,年龄,经验值,加入日期)values(''风云舞'',''12345678''"&_
",18,365,''"&Now&"'')"
link1.Execute"insertinto新建表"&str1&"(会员名,密码,年龄,经验值,加入日期)values(''Lshdic'',''87654321''"&_
",18,365,''"&Now&"'')"
opendatabasepubdatapath''刷新重装载列表
Case2:''刷新——重装载
opendatabasepubdatapath
Case3:''删除
Ifrs.State=1Thenrs.Close
link1.Execute"Droptable"&list1.SelectedItem.Text
opendatabasepubdatapath
Case4:''表属性
Ifrs.State=1Thenrs.Close
rs.Open"select*from"&list1.SelectedItem.Text,link1,adOpenStatic,adLockReadOnly
Fori=0Tors.Fields.Count-1
str1=str1&rs.Fields(i).Name&","
str2=str2&rs.Fields(i).Type&","
str3=str3&rs.Fields(i).ActualSize&","
str4=str4&rs.Fields(i).DefinedSize&","
Next
MsgBox"包含字段:"&str1&vbCrLf&vbCrLf&"字段类型:"&str2&vbCrLf&vbCrLf&"第一行数据大小:"&_
str3&vbCrLf&vbCrLf&"每行数据预设容量:"&str4,vbExclamation,"表属性"
EndSelect
EndSub
PrivateSuBText2_GotFocus()
IfText2.Text="查找关键字..."ThenText2.Text=""
EndSub
PrivateSuBText2_LostFocus()
IfText2.Text=""ThenText2.Text="查找关键字..."
EndSub
PrivateSubup_Click()''功能，上一页
page=page-1:list1_MouseUp1,0,10,10
EndSub
