Question

VB如何实现查询数据库并显示出来？

我想要实现以下的功能：在Text文本框中输入一段信息，然后点击按钮，就会把所有access数据库中相关的信息以一条一条的格式显示在下拉列表中。

Answer 1

可以快速导出使用excel 就有该功能

Public Function ExportToExcel(ByVal strOpen As String, Title As String, dizhi As String, con As ADODB.Connection)
  '*********************************************************
  '*   名称：ExporToExcel
  '*   功能：导出数据到EXCEL'*   用法：ExporToExcel(strOpen查询字符串，titile
  '*excel标题,dizhi 保存路径，con  数据库连接地址)
  '*********************************************************
lok:  On Error GoTo er
  Screen.MousePointer = 11
  Dim Rs_Data     As New ADODB.Recordset
          Dim Irowcount     As Long
          Dim Icolcount     As Long
         
        Dim XlApp     As New Excel.Application
        Dim xlbook     As Excel.Workbook
        Dim xlSheet     As Excel.Worksheet
        Dim xlQuery     As Excel.QueryTable
         
        With Rs_Data
                If .State = adStateOpen Then
                        .Close
                End If
                 .ActiveConnection = con
                 .CursorLocation = adUseClient
                 .CursorType = adOpenStatic
                 .LockType = adLockReadOnly
                 .Source = strOpen
                 DoEvents
      '           Debug.Print strOpen
                 .Open
                 
         End With
         Debug.Print strOpen
        '  Set Rs_Data = Open_rst_from_str(strOpen)
        With Rs_Data
                If .RecordCount < 1 Then
                        MsgBox ("没有记录!")
                        Screen.MousePointer = 0
                        Exit Function
                End If
                '记录总数
                Irowcount = .RecordCount
                '字段总数
                Icolcount = .Fields.Count
        End With
         
        Set XlApp = CreateObject("Excel.Application")
        Set xlbook = Nothing
        Set xlSheet = Nothing
        Set xlbook = XlApp.Workbooks().Add
        Set xlSheet = xlbook.Worksheets("sheet1")

         
        '添加查询语句，导入EXCEL数据
        Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
         
        With xlQuery
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = True
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .PreserveColumnInfo = True
        End With
         
        xlQuery.FieldNames = True       '显示字段名
        xlQuery.Refresh
           
          Dim i     As Integer, Zd       As String
        With xlSheet
                  For i = 1 To 6
               
                          Zd = .Range(.Cells(1, 1), .Cells(1, Icolcount)).item(1, i)
                       '   .Range(.Cells(1, 1), .Cells(1, Icolcount)).Item(1, i) = Lm_YwToZw(Zd)
                  Next
                .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.name = "黑体"
                '设标题为黑体字
  '               .Range(.Cells(1,   1),   .Cells(1,   Icolcount)).Font.Bold   =   True
                '标题字体加粗
                .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
  '               .Range(.Cells(Irowcount   +   2,   Icolcount)).Text   =   Zje
                '设表格边框样式
        End With
        XlApp.Visible = True
        XlApp.Application.Visible = True
  '      xlBook.SaveAs dizhi
        Set XlApp = Nothing           '"交还控制给Excel
        Set xlbook = Nothing
        Set xlSheet = Nothing
        Screen.MousePointer = 0
        Exit Function
er:
     '   Dispose_Err
     MsgBox err.Description & "           从新导报表，请等待！"

     GoTo lok:
  End Function

使用这个模块就可以，你可以看看引用的函数即可

Answer 2

参考代码如下：
Private Sub Command1_Click()
on error goto errhandle
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Cnn.ConnectionString = "Provider=SQLOLEDB;Data Source=john;UID=sa;PWD=123;initial catalog=aaa"
Cnn.Open
if rs.state<>adstateclosed then rs.close
Rs.Open "select A from aaa", Cnn ,adopenkeyset,adlockreadonly
if rs.recordcount>0 then
label1.caption=rs!a & ""
label1.refresh
end if
rs.close
cnn.close
exit sub
'错误处理
ErrHandle:
msgbox "查询失败，错误原因为：" & err.description,vbexclamation,"提示"
if rs.state<>adstateclosed then rs.close
if cnn.state<>adstateclosed then cnn.close
end sub

Answer 3

新建数据库c:\db1.mdb，其中创建一个名为表1的表，表中加入字段username，加入张三，张四，李五，李六..随便输入几个名字保存。
Private Sub Command1_Click()Set conn = CreateObject("adodb.connection")Set rs = CreateObject("adodb.recordset")conn.open "provider=microsoft.jet.oledb.4.0;data source=c:\db1.mdb"rs.open "select username from 表1 where username like '李*'", conn, 1, 1
do while not rs.eof
list1.additem rs("username") rs,movenext
looprs.closeset rs=nothingset conn=nothing
end sub
'command1单击后list1列出所有username字段中姓李的名字，查询语句usermane like '李*'，表示返回所有第一个字符为‘李’且后面有任意个任意字符的名字。‘*’表示任意多个字符。