（mccad请进）VBA与Access链接查询求教

idoo

VBA中，需要根据三个条件在Access中查询符合条件的记录：要求同时以VBA中的三个条件，查找出Access中符合要求的记录。我在作数据库链接时好像是陷入了死循环，电脑就没有了反映……请高手指点该如何链接、查询！！！

mccad

你的代码？

idoo

先谢谢mccad大师！

Dim wr As Workspace '声明工作空间变量,为打开数据库提供空间
Dim db As Database  '声明数据库对象变更,用于打开数据库
Dim dl As Recordset '声明数据库表,用于打开数据库库表
Dim xl As Recordset
Dim DTYPE As Recordset
Dim DLOAD As Recordset
Dim DSPEED As Recordset
Dim DNBE As Recordset
Dim DNBS As Recordset
Dim DRMax As Recordset

Set wr = CreateWorkspace("", "admin", "", dbUseJet)
Set db = wr.OpenDatabase("C:\Program Files\Database.mdb", False, True, "")
Set dl = db.OpenRecordset("Data", dbOpenDynaset, dbReadOnly)
Do
    If dl.EOF = False Then
        cobType.AddItem dl.Fields("Type").Value
        dl.MoveNext
    Else
        Exit Do
    End If
Loop

以上为Access连接部分，实际上我是要根据Access中的DTYPE、DLOAD、DSPEED、DNBE、DNBS、和DRMax，总共6列的数据来最终查找出一条记录，并将找出的这条记录中的其它字段的数据赋值给AutoCAD VBA窗口中的相应控件。

zhuxuhong

改为

    Do while Not dl.EOF
        cobType.AddItem dl.Fields("Type").Value
        dl.MoveNext
    Loop

idoo

以上是我的Access数据

idoo

怎么解决？？

还有找到后怎么从access中取数值？这方面是一窍不通啊～～～

laoxie_198

控件＝dl.Fields("Type").’将access字段值付给控件某个属性。

idoo

大家有没有这种的成功案例啊～～

mccad

2. Public Function OpenConnection(DbPath)
3.     Dim TempConn
4.     'On Error Resume Next
5.     Set OpenConnection = CreateObject("ADODB.Connection")
6.     OpenConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbPath
7.     If Err Then
8.         Err.Clear
9.         MsgBox "链接出错，请检查数据库链接字符串！"
10.     End If
11. End Function
12. Sub DoAccess()
13.     Dim RS, CONN
14.     Dim DbPath As String
15.     Dim TableList
16.     Dim RecordCnt As Integer
17.     Dim i As Integer
18.     DbPath = "D:\mdbpath\mdbfile.mdb"
19.     Set CONN = OpenConnection(DbPath)
20.     If IsObject(CONN) Then
21.         Set RS = CONN.execute("select  DTYPE,DLOAD,DSPEED,DNBE,DNBS,DRMax from mdbtable where  dtype=true and dload=15")
22.         If RS.bof And RS.EOF Then
23.             RS.Close: Set RS = Nothing: Set CONN = Nothing
24.             Exit Sub
25.         End If
26.          '
27.         TableList = RS.GetRows(-1)
28.         Set RS = Nothing
29.         Set CONN = Nothing
30.         RecordCnt = UBound(TableList, 2)
31.         For i = 0 To RecordCnt
32.             Debug.Print TableList(0, i)
33.             Debug.Print TableList(1, i)
34.             Debug.Print TableList(2, i)
35.             Debug.Print TableList(3, i)
36.             Debug.Print TableList(4, i)
37.             Debug.Print TableList(5, i)
38.             Debug.Print "+++++++++++++++++++"
39.         Next
40.     End If
41. End Sub

Public Function OpenConnection(DbPath)     Dim TempConn     'On Error Resume Next     Set OpenConnection = CreateObject("ADODB.Connection")     OpenConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbPath     If Err Then         Err.Clear         MsgBox "链接出错，请检查数据库链接字符串！"     End If End Function Sub DoAccess()     Dim RS, CONN     Dim DbPath As String     Dim TableList     Dim RecordCnt As Integer     Dim i As Integer     DbPath = "D:\mdbpath\mdbfile.mdb"     Set CONN = OpenConnection(DbPath)     If IsObject(CONN) Then         Set RS = CONN.execute("select  DTYPE,DLOAD,DSPEED,DNBE,DNBS,DRMax from mdbtable where  dtype=true and dload=15")         If RS.bof And RS.EOF Then             RS.Close: Set RS = Nothing: Set CONN = Nothing             Exit Sub         End If          '         TableList = RS.GetRows(-1)         Set RS = Nothing         Set CONN = Nothing         RecordCnt = UBound(TableList, 2)         For i = 0 To RecordCnt             Debug.Print TableList(0, i)             Debug.Print TableList(1, i)             Debug.Print TableList(2, i)             Debug.Print TableList(3, i)             Debug.Print TableList(4, i)             Debug.Print TableList(5, i)             Debug.Print "+++++++++++++++++++"         Next     End If End Sub

jxh2003zfr

.