用红色标记的均报同样的错误:错误"91"对象变量或with块变量未设置
Dim cn As New adodb.Connection
Dim mrc As adodb.Recordset, mrc2 As adodb.Recordset
Dim txtsql As String
Dim msgtext As String
Public Function connectstring() As String
connectstring = "provider=microsoft.jet.oldb.4.0;data source=is.mdb"
End Function
Public Function runselect(ByVal sql As String, msgs As String) As adodb.Recordset
Dim cn As adodb.Connection
Dim rs As adodb.Recordset
On Error GoTo runselect_error
Set cn = New adodb.Connection
cn.Open connectstring()
Set rs = New adodb.Recordset
rs.CursorLocation = adUseClient
rs.Open Trim$(sql), cn, adOpenKeyset
Set runselect = rs
msgs = "查询到" & rs.RecordCount & "条记录"
runselect_exit:
Set rs = Nothing
Set cn = Nothing
Exit Function
runselect_error:
msgs = "查询错误：" & Err.Description
Resume runselect_exit
End Function
Public Function runsql(ByVal aql As String, msgs As String)
Dim cn As Connection
On Error GoTo runsql_error
Set cn = New Connection
cn.Open connectstring()
cn.Execute sql
msgs = sql & "successful"
Set cn = Nothing
Exit Function
runsql_error:
msgs = "查询错误：" & Err.Description
Set cn = Nothing
End Function
Private Sub Command1_Click()
Adodc1.Recordset.MoveLast
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(0).Value = n
Adodc1.Recordset.Fields(1).Value = ""
Adodc1.Recordset.Fields(2).Value = ""
Adodc1.Recordset.Fields(3).Value = ""
Adodc1.Recordset.Fields(4).Value = ""
Adodc1.Recordset.Fields(5).Value = ""
Adodc1.Recordset.Fields(6).Value = ""
Adodc1.Recordset.Fields(7).Value = 0
Adodc1.Recordset.Fields(8).Value = ""
Adodc1.Recordset.Update
End Sub
Private Sub Command2_Click()
If Adodc1.Recordset.RecordCount >= 1 Then
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveLast
Else
MsgBox "已无记录可删"
End If
Adodc1.Recordset.MoveLast
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Command5_Click()
If mrc.RecordCount >= 1 Then mrc.MoveFirst
Call DataGrid1_Click
End If
End Sub
Private Sub Command6_Click()
If mrc.RecordCount >= 1 Then mrc.MoveLast
Call DataGrid1_Click
End If
End Sub
Private Sub Command7_Click()
If mrc.BOF = True Then
MsgBox "已到头！"
Else
mrc.MovePrevious
If mrc.BOF = True Then
mrc.MoveFirst
MsgBox "已是第一个！"
End If
End If
If mrc.RecordCount >= 1 Then
Call DataGrid1_Click
End If
End Sub
Private Sub Command8_Click()
If mrc.EOF = True Then
MsgBox "已到尾！"
Else
mrc.MoveNext
If mrc.EOF = True Then
mrc.MoveLast
MsgBox "已是最后一个！"
End If
End If
If mrc.RecordCount >= 1 Then
Call DataGrid1_Click
End If
End Sub
Private Sub Command9_Click()
txtsql = "select * from 用户查询 where"
If Len(Trim(Text1.Text)) >= 1 Then
txtsql = txtsql & "承租人='" & Text1.Text & "'"
ElseIf Len(Trim(Text2.Text)) >= 1 Then
txtsql = txtsql & "编号='" & Text2.Text & "'"
ElseIf Len(Trim(Text3.Text)) >= 1 Then
txtsql = txtsql & "配置='" & Text3.Text & "'"
ElseIf Len(Trim(Text4.Text)) >= 1 Then
txtsql = txtsql & "地址='" & Text4.Text & "'"
ElseIf Len(Trim(Text5.Text)) >= 1 Then
txtsql = txtsql & "状态='" & Text5.Text & "'"
ElseIf Len(Trim(Text6.Text)) >= 1 Then
txtsql = txtsql & "联系电话='" & Text6.Text & "'"
ElseIf Len(Trim(Text7.Text)) >= 1 Then
txtsql = txtsql & "租金='" & Text7.Text & "'"
ElseIf Len(Trim(Text8.Text)) >= 1 Then
txtsql = txtsql & "租金支付状态='" & Text8.Text & "'"
ElseIf Len(Trim(Text9.Text)) >= 1 Then
txtsql = txtsql & "备注='" & Text9.Text & "'"
Else
txtsql = "select * from 用户查询"
End If
Set mrc = runselect(txtsql, msgtext)
iferror (msgtext)
Set DataGrid1.DataSource = mrc
If mrc.RecordCount >= 1 Then
Call DataGrid1_Click
End If
End Sub
Private Sub DataGrid1_Click()
If DataGrid1.Columns.Count >= 8 Then
Text1.Text = DataGrid1.Columns(3).Text
Text2.Text = DataGrid1.Columns(0).Text
Text3.Text = DataGrid1.Columns(1).Text
Text4.Text = DataGrid1.Columns(4).Text
Text5.Text = DataGrid1.Columns(2).Text
Text6.Text = DataGrid1.Columns(5).Text
Text7.Text = DataGrid1.Columns(7).Text
Text8.Text = DataGrid1.Columns(8).Text
Text9.Text = DataGrid1.Columns(6).Text
txtsql = "select * from 用户查询 where 编号='" & Trim(Text2.Text) & "'"
Set mrc2 = runselect(txtsql, msgtext)
Set DataGrid2.DataSource = mrc2
End If
End Sub
Private Sub Form_Load()
Set mrc = runselect("select*from 用户查询", msgtext)
If mrc Is Nothing Then Exit Sub
Set DataGrid1.DataSource = mrc
If mrc.RecordCount >= 1 Then
Call DataGrid1_Click
End If
End Sub
Private Sub iferror(msgtext As String)
If InStr(msgtext, "查询错误") Then
MsgBox "error in query! reset,try again!"
Set mrc = runselect("select * from 用户查询", msgtext)
Set DataGrid1.DataSource = mrc
If mrc.RecordCount >= 1 Then Call DataGrid1_Click
End If
End If
End Sub 作者:
sytumaer 时间: 2006-4-29 10:33
自己顶 作者:
Nothing 时间: 2006-4-29 17:37
Private Sub Command5_Click()
on error resume next
If mrc.RecordCount >= 1 Then
mrc.MoveFirst '注意换行
Call DataGrid1_Click
End If
End Sub
Private Sub Command6_Click()
on error resume next
If mrc.RecordCount >= 1 Then
mrc.MoveLast
Call DataGrid1_Click
End If
End Sub
