|
本帖最后由 鱼儿游游 于 2012-3-6 00:57 编辑
帮你写了以下代码:不用链接表读取ADO记录集,并在子窗体显示取回的ADO记录集,供楼主参考。- Private Sub cmd查询_Click()
- On Error GoTo Err_Handler
-
- Dim rst As Object
- Dim strShop As String
- Dim strProd As String
- Dim strSQL As String
-
- '关闭屏幕刷新
- Application.Echo False
- '设置鼠标指针为沙漏形状
- DoCmd.Hourglass True
-
- '定义子窗体的数据源的SQL语句
- Me.t店铺 = Trim(Nz(Me.t店铺, ""))
- Me.t产品 = Trim(Nz(Me.t产品, ""))
- strShop = IIf(Len(Me.t店铺) = 0, "%", "%" & Me.t店铺 & "%")
- strProd = IIf(Len(Me.t产品) = 0, "%", "%" & Me.t产品 & "%")
- strSQL = "SELECT 订单明细.店铺名称, 订单明细.产品, Sum(订单明细.规格1) as 规格1," _
- & " Sum(订单明细.规格2) As 规格2, Sum(订单明细.规格3) As 规格3 FROM 订单明细" _
- & " GROUP BY 订单明细.店铺名称, 订单明细.产品" _
- & " HAVING 订单明细.店铺名称 Like '" & strShop & "' And 订单明细.产品 Like '" & strProd & "'"
-
- '设置子窗体的数据源
- If GetRecordset(rst, strSQL, 1, 1) Then
- SetFieldName True
- Set Me.Controls("订单汇总子窗体").Form.Recordset = rst
- Else
- SetFieldName False
- End If
-
- Exit_Handler:
- '恢复鼠标指针
- DoCmd.Hourglass False
- '打开屏幕刷新
- Application.Echo True
- Exit Sub
-
- Err_Handler:
- MsgBox Err.Descripton, vbExclamation, "读取数据"
- Resume Exit_Handler
-
- End Sub
- Private Sub SetFieldName(Optional ByVal blnDisplayRecordset As Boolean = True)
- If blnDisplayRecordset Then
- Forms!订单查询!订单汇总子窗体!t店铺名.ControlSource = "店铺名称"
- Forms!订单查询!订单汇总子窗体!t产品.ControlSource = "产品"
- Forms!订单查询!订单汇总子窗体!t规格1.ControlSource = "规格1"
- Forms!订单查询!订单汇总子窗体!t规格2.ControlSource = "规格2"
- Forms!订单查询!订单汇总子窗体!t规格3.ControlSource = "规格3"
- Else
- Forms!订单查询!订单汇总子窗体!t店铺名.ControlSource = ""
- Forms!订单查询!订单汇总子窗体!t产品.ControlSource = ""
- Forms!订单查询!订单汇总子窗体!t规格1.ControlSource = ""
- Forms!订单查询!订单汇总子窗体!t规格2.ControlSource = ""
- Forms!订单查询!订单汇总子窗体!t规格3.ControlSource = ""
- End If
- End Sub
复制代码 调用函数如下:- Option Compare Database '使用数据库的字符串比较方式
- Option Explicit '变量在使用前必须进行显式声明
- '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- Public cn As Object '定义全程变量:数据链接对象(ADODB.Connection),用来保存连接数据库信息变量。
- '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
- '=======================================
- ' 建立与后台数据库的链接(无链接表方式)
- '=======================================
- Public Function ADODB_Connect(Optional ByVal strDatabase As String = ".\Data.MDB", Optional ByVal strPwd As String = "") As Boolean
- On Error GoTo Err_ADODB_Connect
-
- Dim strConnect As String
- strDatabase = Trim(Nz(strDatabase, ""))
- '如果是简写的路径则转换为绝对路径
- If strDatabase Like ".\*" Then strDatabase = CurrentProject.Path & Mid(strDatabase, 2)
- '如果是相对路径则转换为绝对路径
- If Left(strDatabase, 1) = "" Then strDatabase = Mid(CurrentProject.Path, 1, 2) & strDatabase
- If Not strDatabase Like "[A-z]:*" Then strDatabase = CurrentProject.Path & "" & strDatabase
- '定义ACCESS链接串
- strConnect = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" & strDatabase & ";Jet OLEDB:Database Password=" & strPwd
-
- '用ADO通过OLEDB直接连接数据库
- Set cn = Nothing
- Set cn = CreateObject("ADODB.Connection")
- cn.ConnectionString = strConnect
- cn.CursorLocation = adUseClient
- cn.ConnectionTimeout = 15
- cn.CommandTimeout = 30
- cn.Open
- ADODB_Connect = True
- Exit_ADODB_Connect:
- Exit Function
- Err_ADODB_Connect:
- ADODB_Connect = False
- MsgBox "连接后台数据库【" & strDatabase & "】失败!" \ Chr(10) & Chr(10) & "出错原因:" & Err.Description, 64, "出错信息"
- '并释放变量
- Set cn = Nothing
- Resume Exit_ADODB_Connect
- End Function
- '=======================================
- ' 打开记录集
- '=======================================
- Public Function GetRecordset(ByRef rst As Object, _
- ByRef strSQL As String, _
- Optional ByRef intOpenKeyset As Integer = adOpenKeyset, _
- Optional ByRef intLockOptimistic As Integer = adLockReadOnly, _
- Optional ByRef IsCurrentMDB As Boolean = False) As Boolean
- On Error GoTo Err_GetRecordset
- RetryOpen:
- '打开ADO记录集
- Set rst = Nothing
- Set rst = CreateObject("ADODB.Recordset")
- If IsCurrentMDB Then
- '当前MDB
- rst.Open strSQL, CurrentProject.AccessConnection, intOpenKeyset, intLockOptimistic
- Else
- With rst
- .Source = strSQL
- .ActiveConnection = cn
- .CursorLocation = adUseClient '3
- .CursorType = intOpenKeyset
- .LockType = intLockOptimistic
- .Open
- End With
- End If
- GetRecordset = True
- If rst.RecordCount > 0 Then rst.MoveFirst
- Exit_GetRecordset:
- Exit Function
- Err_GetRecordset:
- If Not IsCurrentMDB Then
- Dim intCounter As Integer
- '与数据库断开连接,则重新连接一次。
- If Err.Number = 91 Or cn Is Nothing Then
- If intCounter = 0 Then
- intCounter = intCounter + 1
- If ADODB_Connect Then Resume RetryOpen
- End If
- ElseIf Err.Number = 3709 Then
- If intCounter = 0 Then
- intCounter = intCounter + 1
- Sleep 1000
- Resume RetryOpen
- End If
- ElseIf Err.Number = -2147217865 Then
- If intCounter = 0 Then
- intCounter = intCounter + 1
- Sleep 1000
- Resume
- End If
- End If
- End If
- GetRecordset = False
- '并释放变量
- Set rst = Nothing
- '显示错误信息
- MsgBox Err.Description, vbExclamation, "打开记录集过程:GetRecordset"
- Resume Exit_GetRecordset
- End Function
复制代码 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|