ADO与ACCESS2000的问题

Option Explicit
Private CnProduct As New ADODB.Connection     '产品数据库的连接
Private CnAllData As New ADODB.Connection     '产品板数据库的连接（全数据存储）
Private RtProduct As New ADODB.Recordset      '产品数据库的记录集
Private RtAllData As New ADODB.Recordset      '产品板数据库的记录集（全数据存储）Dim sModel(1 To 60) As String           '产品规格数组'该函数实现程序控制的数据库连接，即由程序指定连接哪个数据库
Private Function Connect(sPath As String, iFlag As Integer) As Boolean
'连接数据库，获得记录集
CnProduct.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0"
CnAllData.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0"
'sPath存储数据库的相对路径，如"\数据库\Model.mdb"
'存储连接数据库的类型，1表示连接产品数据库，否则连接全数据存储数据库
    If iFlag = 1 Then
        CnProduct.Open App.Path & sPath
        RtProduct.ActiveConnection = CnProduct
    Else
        CnAllData.Open App.Path & sPath
        RtAllData.ActiveConnection = CnAllData
    End If
    Connect = True
End Function'用于插入产品数据库
Public Function InsertProduct(sNo As String, Bresult As Byte, lQuality As Currency, Lmin As Single, Lave As Single, Lmax As Single, Mmin As Single, Mave As Single, Mmax As Single, Rmin As Single, Rave As Single, Rmax As Single, Pizhong As Single) As Boolean
'sNo存储产品编号，长度为13
'bResult存储测试结果
'lQuality产品质量
'Lmax,Iave,Lmin分别存储左路数据的最大值、平均值、最小值
'Mmax,Mave,Mmin分别存储中路数据的最大值、平均值、最小值
'Rmax,Rave,Rmin分别存储右路数据的最大值、平均值、最小值
'Pizhong存储料重
Dim sTemp As String      '存储日期字符串
'插入数据库     Connect "\日\" & Mid(sNo, 1, 4) & ".mdb", 1
     RtProduct.Open "Product", CnProduct, adOpenDynamic, adLockPessimistic
     '添加到数据库
     RtProduct.AddNew
     RtProduct.Fields(0) = sNo

     '测试结果
     RtProduct.Fields(1) = Bresult

     '产品质量
     RtProduct.Fields(2) = Format(lQuality, "###0.00")

     '左路测试数据
     RtProduct.Fields(3) = Format(Lmin, "###0.00")
     RtProduct.Fields(4) = Format(Lave, "###0.00")
     RtProduct.Fields(5) = Format(Lmax, "###0.00")

     '中路测试数据
     RtProduct.Fields(6) = Format(Mmin, "###0.00")
     RtProduct.Fields(7) = Format(Mave, "###0.00")
     RtProduct.Fields(8) = Format(Mmax, "###0.00")

     '右路测试数据
     RtProduct.Fields(9) = Format(Rmin, "###0.00")
     RtProduct.Fields(10) = Format(Rave, "###0.00")
     RtProduct.Fields(11) = Format(Rmax, "###0.00")

     '坯重
     RtProduct.Fields(12) = Format(Pizhong, "###0.00")

     RtProduct.Update     '关闭连接对象
     CnProduct.Close

InsertProduct = True      '操作成功，返回True

End Function'用于插入全数据存储的数据库
Public Function InsertAllData(L() As Single, M() As Single, R() As Single) As Boolean
'L()存储左路测试数据
'M()存储中路测试数据
'R()存储右路测试数据Dim i As Integer   '循环变量
i = 1
Connect "\AllData\Data.mdb", 0
RtAllData.Open "Data", CnAllData, adOpenDynamic, adLockPessimistic
'插入全数据存储数据库
    While (i < UBound(L()) + 1)
        RtAllData.AddNew

        RtAllData.Fields(0) = Format(L(i), "###0.00")
        RtAllData.Fields(1) = Format(M(i), "###0.00")
        RtAllData.Fields(2) = Format(R(i), "###0.00")

        RtAllData.Update
        i = i + 1
    Wend

CnAllData.Close
InsertAllData = True                '操作成功返回True
End Function'处理日期字段，如：01-8-10转换为010810
Private Function DateString() As String
    Dim CurrentDate As Date
    Dim str() As String        '用于处理的字符串
    Dim i As Integer           '循环变量
    Dim str1 As String          '用于处理日期字符串
    CurrentDate = Date          '获得当前的日期，格式如：01-8-10

    str1 = CStr(CurrentDate)
    str = Split(str1, "-")
    For i = 0 To 2
        If (Len(str(i)) = 1) Then str(i) = "0" & str(i)     '处理日期字符串，8转换为08
    Next
    DateString = str(0) & str(1) & str(2)                   '返回处理后的字符串
End Function'创建数据库，sPath是路径和全名，如："\日\010821.mdb"
Public Function Creatdatabase(sPath As String) As Boolean
    If (Dir(App.Path & "\日\*.mdb") <> "") Then
        Kill App.Path & "\日\*.mdb"      '清空日数据库文件夹
    End If
    '创建日数据库文件
    FileCopy App.Path & "\DataBase\Model.mdb", App.Path & sPath
    Creatdatabase = True         '操作成功返回True
End FunctionPublic Function ClearAllData()
    Connect "\AllData\Data.mdb", 0
    CnAllData.Execute "delete * from Data"
    CnAllData.Close
End FunctionPublic Function ClearProduct()
    Connect "\DataBase\Model.mdb", 1
    CnProduct.Execute "delete * from Product"
    CnProduct.Close
End Function
'实现一天的班查询
Private Function SearchBan(sDate As String, iBan As Integer, iBanSearchN0() As Integer, iBanSearchN1() As Integer, iBanSearchN2() As Integer, lBanSearchQ0() As Single, lBanSearchQ1() As Single, lBanSearchQ2() As Single, lTouliao0() As Single, lTouliao1() As Single, lTouliao2() As Single)
'sDate是查询的日期，格式为0104或者010402
'iBan是班次，分别为1，2，3
'iBanSearchN0为合格品个数，iBanSearchN1为待磨品个数，
'iBanSearchN2为残缺品个数
'lBanSearchQ0为合格品总质量，lBanSearchQ1为待磨品总质量
'lBanSearch2为残缺品的总质量
'lTouliao0为合格品投料总质量，lTouliao1为待磨品投料总质量
'lTouliao2为残缺品的投料总质量    Dim i As Integer  '循环变量
    '查询数据库
    RtProduct.Open "select 产品编号,测试结果,产品质量,料重 from Product where 产品编号 like " & "'" & sDate & "%'"
    '便历返回的记录集进行查询和统计
    While (RtProduct.EOF <> True)
            '检查是否是要检查的班次
            If (Mid(RtProduct(0), 7, 1) = CStr(iBan)) Then
                '与规格数组进行比较，并在相应的对象上统计
                For i = 1 To 60
                    If (Mid(RtProduct(0), 12, 2) = sModel(i)) Then
                        If (RtProduct(1) = 1) Then
                            iBanSearchN0(i) = iBanSearchN0(i) + 1               '合格品个数加1
                            lBanSearchQ0(i) = lBanSearchQ0(i) + RtProduct(2)   '合格品质量累加
                            lTouliao0(i) = lTouliao0(i) + RtProduct(3)   '合格品投料质量累加
                        ElseIf (RtProduct(1) = 2) Then
                            iBanSearchN1(i) = iBanSearchN1(i) + 1               '待磨品个数加1
                            lBanSearchQ1(i) = lBanSearchQ1(i) + RtProduct(2)   '待磨品质量累加
                            lTouliao1(i) = lTouliao1(i) + RtProduct(3)   '待磨品投料质量累加
                        Else
                            iBanSearchN2(i) = iBanSearchN2(i) + 1               '残缺品个数加1
                            lBanSearchQ2(i) = lBanSearchQ2(i) + RtProduct(2)   '残缺品质量累加
                            lTouliao2(i) = lTouliao2(i) + RtProduct(3)   '残缺品投料质量累加
                        End If
                    End If
                Next i
            End If
            RtProduct.MoveNext              '指向下一条记录
        Wend
    RtProduct.Close
End Function'实现按班次检索，sDate是日期（可以是月份，也可以是日期），iBan是班次
Public Function SearchbyBan(sDate As String, iBan As Integer, _
                iBanSearchN0() As Integer, iBanSearchN1() As Integer, _
                iBanSearchN2() As Integer, lBanSearchQ0() As Single, _
                lBanSearchQ1() As Single, lBanSearchQ2() As Single, lTouliao0() As Single, lTouliao1() As Single, lTouliao2() As Single)
'iBanSearchN0为合格品个数，iBanSearchN1为待磨品个数，
'iBanSearchN2为残缺品个数
'lBanSearchQ0为合格品总质量，lBanSearchQ1为待磨品总质量
'lBanSearch2为残缺品的总质量
'lTouliao0为合格品投料总质量，lTouliao1为待磨品投料总质量
'lTouliao2为残缺品的投料总质量Dim i As Integer   '循环变量
    '初始化结果数据
    For i = 1 To 60
        iBanSearchN0(i) = 0
        iBanSearchN1(i) = 0
        iBanSearchN2(i) = 0
        lBanSearchQ0(i) = 0
        lBanSearchQ1(i) = 0
        lBanSearchQ2(i) = 0
    Next i

    '初始化规格数组
    SearchInit

    Connect "\日\" & Mid(sDate, 1, 4) & ".mdb", 1
    '把月份的查询转化为日期的查询，缩小返回的记录集对象，提高查询效率
    '日期长度为4，表示要查询的是月份，转化为对日期的查询
    If (Len(sDate) = 4) Then
        For i = 1 To 31
            If (i < 10) Then
                SearchBan sDate & "0" & i, iBan, iBanSearchN0, iBanSearchN1, iBanSearchN2, lBanSearchQ0, lBanSearchQ1, lBanSearchQ2, lTouliao0, lTouliao1, lTouliao2
            Else
                SearchBan sDate & i, iBan, iBanSearchN0, iBanSearchN1, iBanSearchN2, lBanSearchQ0, lBanSearchQ1, lBanSearchQ2, lTouliao0, lTouliao1, lTouliao2
            End If
        Next i
    '日期的长度是6，表示是对日期的查询，直接查询
    ElseIf (Len(sDate) = 6) Then
        SearchBan sDate, iBan, iBanSearchN0, iBanSearchN1, iBanSearchN2, lBanSearchQ0, lBanSearchQ1, lBanSearchQ2, lTouliao0, lTouliao1, lTouliao2
    '否则是日期格式错误
    Else
        MsgBox "日期格式错误！", , "警告"
    End If
CnProduct.Close
End Function'实现一天的检索
Private Function SearchDay(sDate As String, iBanSearchN0() As Integer, iBanSearchN1() As Integer, iBanSearchN2() As Integer, lBanSearchQ0() As Single, lBanSearchQ1() As Single, lBanSearchQ2() As Single, lTouliao0() As Single, lTouliao1() As Single, lTouliao2() As Single)
'sDate是查询的日期
'iBanSearchN0为合格品个数，iBanSearchN1为待磨品个数，
'iBanSearchN2为残缺品个数
'lBanSearchQ0为合格品总质量，lBanSearchQ1为待磨品总质量
'lBanSearch2为残缺品的总质量
'lTouliao0为合格品投料总质量，lTouliao1为待磨品投料总质量
'lTouliao2为残缺品的投料总质量Dim i As Integer  '循环变量
Dim str As String
    str = "select 产品编号,测试结果,产品质量,料重 from Product where 产品编号 like " & "'" & sDate & "%'"
    Debug.Print str
    RtProduct.Open str
    While (RtProduct.EOF <> True)
            For i = 1 To 60
                If (Mid(RtProduct(0), 12, 2) = sModel(i)) Then
                    If (RtProduct(1) = 1) Then
                        iBanSearchN0(i) = iBanSearchN0(i) + 1               '合格品个数加1
                        lBanSearchQ0(i) = lBanSearchQ0(i) + RtProduct(2)   '合格品质量累加
                        lTouliao0(i) = lTouliao0(i) + RtProduct(3)   '合格品投料质量累加
                    ElseIf (RtProduct(1) = 2) Then
                        iBanSearchN1(i) = iBanSearchN1(i) + 1               '待磨品个数加1
                        lBanSearchQ1(i) = lBanSearchQ1(i) + RtProduct(2)   '待磨品质量累加
                        lTouliao1(i) = lTouliao1(i) + RtProduct(3)   '待磨品投料质量累加
                    Else
                        iBanSearchN2(i) = iBanSearchN2(i) + 1               '残缺品个数加1
                        lBanSearchQ2(i) = lBanSearchQ2(i) + RtProduct(2)   '残缺品质量累加
                        lTouliao2(i) = lTouliao2(i) + RtProduct(3)   '残缺品投料质量累加
                    End If
                End If
            Next i
            RtProduct.MoveNext              '指向下一条记录
        Wend
    RtProduct.Close
End Function
'实现日期的检索
Public Sub SearchByDay(sDate As String, iBanSearchN0() As Integer, iBanSearchN1() As Integer, iBanSearchN2() As Integer, lBanSearchQ0() As Single, lBanSearchQ1() As Single, lBanSearchQ2() As Single, lTouliao0() As Single, lTouliao1() As Single, lTouliao2() As Single)
'sDate是要查询的日期
'iBanSearchN0为合格品个数，iBanSearchN1为待磨品个数，
'iBanSearchN2为残缺品个数
'lBanSearchQ0为合格品总质量，lBanSearchQ1为待磨品总质量
'lBanSearch2为残缺品的总质量
'lTouliao0为合格品投料总质量，lTouliao1为待磨品投料总质量
'lTouliao2为残缺品的投料总质量Dim i As Integer   '循环变量
    '初始化结果数据
    'For i = 1 To 60
       ' iBanSearchN0(i) = 0
       ' iBanSearchN1(i) = 0
       ' iBanSearchN2(i) = 0
      '  lBanSearchQ0(i) = 0
      '  lBanSearchQ1(i) = 0
      '  lBanSearchQ2(i) = 0
   ' Next i

    '初始化规格数组
    SearchInit

    Connect "\日\" & Mid(sDate, 1, 4) & ".mdb", 1

    If (Len(sDate) = 4) Then
        For i = 1 To 31
            If (i < 10) Then
                SearchDay sDate & "0" & i, iBanSearchN0, iBanSearchN1, iBanSearchN2, lBanSearchQ0, lBanSearchQ1, lBanSearchQ2, lTouliao0, lTouliao1, lTouliao2
            Else
                SearchDay sDate & i, iBanSearchN0, iBanSearchN1, iBanSearchN2, lBanSearchQ0, lBanSearchQ1, lBanSearchQ2, lTouliao0, lTouliao1, lTouliao2
            End If
        Next i
    ElseIf (Len(sDate) = 6) Then
        SearchDay sDate, iBanSearchN0, iBanSearchN1, iBanSearchN2, lBanSearchQ0, lBanSearchQ1, lBanSearchQ2, lTouliao0, lTouliao1, lTouliao2
    Else
        MsgBox "日期格式错误！"
    End If
    C

调试易

ADO与ACCESS2000的问题

解决方案 »