vb实时错误：3704 数据库对象关闭时不允许操作

嗯, 不是嘛,检查一下Conn的状态!呵呵.... 实在不行,就把代码帖给大家看看吧!
在之前检查一下吧,应该是连接关闭了，现在又要去操作，所以出现该提示。
检查
if rs.state=adstateclosed then
...
endif
求各位高人帮帮忙啊,谢谢啦!实时错误'3704'
对象关闭时,不允许操作Option Explicit'执行设备显示列表操作
Private Sub doDevice(iid As String)    Dim frm As New frmDevice

    If Len(iid) > 0 Then
        frm.loadDevice iid
    End If

    frm.setStatus

    frm.Show vbModal

    If frm.isUpdate = True Then
        grdDevice.Tag = ""
        Call fillDeviceGrid(grdDevice)
    End If

    Unload frm
    Set frm = NothingEnd Sub'执行用户显示列表操作
Private Sub doUser(uid As String)    Dim frm As New frmUser

    If Len(uid) > 0 Then
        frm.loadUser uid
    End If

    frm.setStatus

    frm.Show vbModal

    If frm.isUpdate = True Then
        grdUser.Tag = ""
        Call fillUserGrid
    End If

    Unload frm
    Set frm = NothingEnd SubPrivate Sub cmdAdd_Click()    Call doDevice("")

End SubPrivate Sub cmdAll_Click()

    grdQuery.Tag = ""

    fillDeviceGrid grdQueryEnd SubPrivate Sub cmdExit_Click()    If MsgBox("是否真的要退出系统吗?", vbYesNo) = vbYes Then
        Unload Me
    End IfEnd SubPrivate Sub cmdGetDate_Click(Index As Integer)    Dim thedate As String

    thedate = getDate(txtDate(Index).Text)

    If Len(thedate) > 0 Then txtDate(Index).Text = thedate

End Sub
Private Sub cmdReport1_Click()    Dim report As New drDevice
    Dim rs As ADODB.Recordset

    Set rs = gConn.Execute("SELECT * FROM tbldevice")
    With report
        Set .DataSource = rs
        .DataMember = ""

        .Show vbModal

    End With

    Set report = NothingEnd SubPrivate Sub cmdReport2_Click()    Dim report As New drDepartment
    Dim rs As ADODB.Recordset

    Set rs = gConn.Execute("SELECT department,count(*) as countofDevice, sum(productprice) as sumofDevice FROM tbldevice a inner join tbldepartment b on a.deptno=b.deptno group by b.department")
    With report
        Set .DataSource = rs
        .DataMember = ""

        .Show vbModal

    End With

    Set report = Nothing
End SubPrivate Sub cmdReport3_Click()    Dim report As New drReject
    Dim rs As ADODB.Recordset

    Set rs = gConn.Execute("SELECT devicename, department,rejectdate FROM tbldevice a inner join tbldepartment b on a.deptno=b.deptno where rejectdate is not null")
    With report
        Set .DataSource = rs
        .DataMember = ""

        .Show vbModal

    End With

    Set report = Nothing
End SubPrivate Sub cmdReport4_Click()
    Dim report As New drCost
    Dim rs As ADODB.Recordset

    Set rs = gConn.Execute("SELECT devicename, department,productprice, productcost FROM tbldevice a inner join tbldepartment b on a.deptno=b.deptno")
    With report
        Set .DataSource = rs
        .DataMember = ""

        .Show vbModal

    End With

    Set report = NothingEnd SubPrivate Sub cmdReset_Click()    If MsgBox("你是否真的要重置数据库吗?这个操作将会删除所有记录!", vbOKCancel + vbDefaultButton2) = vbOK Then
        gConn.Execute "delete from tbldevice"
        gConn.Execute "delete from tbluser"
        gConn.Execute "delete from tbllend"
        gConn.Execute "insert into tbluser (login,pwd,level) values ('admin','888',-1)"

        gConn.Close

        MsgBox "重置数据库成功!管理系统将退出!!!"

        Unload Me

    End If
    End SubPrivate Sub cmdUserAdd_Click()    Call doUser("")

End SubPrivate Sub Form_Load()    Dim rs As ADODB.Recordset

    Dim strSQL As String

    strSQL = "SELECT * FROM tblTypeInfo ORDER BY TypeNO"
    Set rs = gConn.Execute(strSQL)

    cboQTypeNO.AddItem ""

    With rs
        Do Until .EOF
            cboQTypeNO.AddItem .Fields("TypeNO").value & "-" & .Fields("TypeName").value
            .MoveNext
        Loop
    End With    cboQTypeNO.ListIndex = 0

    strSQL = "SELECT * FROM tblDepartment ORDER BY DeptNO"
    Set rs = gConn.Execute(strSQL)

    cboQDept.AddItem ""
    With rs
        Do Until .EOF
            cboQDept.AddItem .Fields("DeptNO").value & "-" & .Fields("Department").value
            .MoveNext
        Loop
    End With

    cboQDept.ListIndex = 0

    rs.Close
    Set rs = Nothing

    With tabMain
        Select Case gUser.Level
            Case 1  '数据操作员
                .TabVisible(3) = False
                fillDeviceGrid grdDevice
                frameSystem.Visible = False

            Case -1 '系统管理员
                fillDeviceGrid grdDevice
                .TabVisible(0) = False
                .TabVisible(1) = False
                .TabVisible(2) = False
                frameSystem.Visible = True

            Case Else   '普通人员
                .Tab = 1
                .TabVisible(0) = False
                .TabVisible(3) = False
                frameSystem.Visible = False

        End Select
    End With

End SubPrivate Sub Form_Unload(Cancel As Integer)
    gConn.Close
    Set gConn = Nothing
    Set gUser = Nothing

End SubPrivate Sub grdDevice_DblClick()

    Dim iid As String

    With grdDevice
        If .Row > 0 Then
            .Col = 1
            iid = .Text
            Call doDevice(iid)
        End If
    End WithEnd SubPrivate Sub grdUser_DblClick()    Dim uid As String

    With grdUser
        If .Row > 0 Then
            .Col = 1
            uid = .Text
            Call doUser(uid)
        End If
    End WithEnd SubPrivate Sub tabMain_Click(PreviousTab As Integer)

    Dim strSQL As String

    Select Case tabMain.Tab
        Case 0
            strSQL = "SELECT a.*,b.department,c.TypeName FROM (tblDevice AS A INNER JOIN tblDepartment AS B ON a.DeptNO=b.DeptNO) INNER JOIN tblTypeInfo C ON a.TypeNO=c.TypeNO ORDER BY A.IID DESC"
            Call fillDeviceGrid(grdDevice, strSQL)

        Case 3
            Call fillUserGrid
    End Select

End SubPrivate Function getDeptNo() As String    Dim str As String
    Dim pos As Integer

    With cboQDept
        str = .List(.ListIndex)
    End With

    pos = InStr(str, "-")

    getDeptNo = Left(str, pos - 1)End FunctionPrivate Function getTypeNO() As String    Dim str As String
    Dim pos As Integer

    With cboQTypeNO
        str = .List(.ListIndex)
    End With

    pos = InStr(str, "-")

    getTypeNO = Left(str, pos - 1)End Function

调试易

vb实时错误：3704 数据库对象关闭时不允许操作

解决方案 »