Option Explicit
Public cn As New ADODB.Connection
Public rst As New ADODB.RecordsetDim xian As Integer
Private Sub CmdExit_Click()
Unload Me
End SubPrivate Sub Command1_Click()
If xian <> 1 Then
            MsgBox "请先点击显示", 0 + 48, "错误提示"
        Else
        rst.MoveNext
        If rst.EOF = True Then
        rst.MoveFirst
 End If
  
        Text1.Text = rst.Fields("宿舍号")
        Text2.Text = rst.Fields("物品")
        Text3.Text = rst.Fields("提交日期")
        Text4.Text = rst.Fields("解决日期")
        Text5.Text = rst.Fields("报修原因")
       
       
 End If
End SubPrivate Sub cmd_Click()
        xian = 1
        Dim ssql As String
        ssql = "select * from 学生报修登记表 order by 宿舍号"
        Set rst = Nothing
        rst.Open ssql, cn, adOpenKeyset, adLockOptimistic
        Set DataGrid1.DataSource = rst
        DataGrid1.Refresh
        Text1.Text = rst.Fields("宿舍号")
        Text2.Text = rst.Fields("物品")
        Text3.Text = rst.Fields("提交日期")
        Text4.Text = rst.Fields("解决日期")
        Text5.Text = rst.Fields("报修原因")
       
End SubPrivate Sub CmdAdd_Click()
    Dim inte As String
    Dim SQLstr As String
    If xian <> 1 Then
            MsgBox "请先点击显示", 0 + 48, "错误提示"
        Else
             If Text1.Text = "" Then
                    MsgBox "宿舍号不能为空", 0 + 48, "错误提示"
             Else
                inte = "select * from 学生报修登记表 where 宿舍号='" & Text1.Text & "'"
                Set rst = Nothing
                rst.Open inte, cn, adOpenKeyset, adLockOptimistic
                DataGrid1.Refresh
                If rst.RecordCount > 0 Then
                    MsgBox "宿舍号重复,插入错误", 0 + 48, "错误提示"
             
                        Else
                             SQLstr = "Insert into 报修表 (宿舍号,物品,提交日期,解决日期,报修原因) values" _
                                    & "('" & Text1.Text & "'" _
                                    & ",'" & Text2.Text & "'" _
                                    & ",'" & Text3.Text & "'" _
                                    & ",'" & Text4.Text & "'" _
                                    & ",'" & Text5.Text & "')"
                            Set rst = Nothing
                            rst.Open SQLstr, cn, adOpenKeyset, adLockOptimistic
                            MsgBox "添加成功!"
                            Call cmd_Click
                        End If
                    End If
                End If
     xian = 1
        Dim ssql As String
        ssql = "select * from 学生报修登记表 order by 宿舍号"
        Set rst = Nothing
        rst.Open ssql, cn, adOpenKeyset, adLockOptimistic
        Set DataGrid1.DataSource = rst
        DataGrid1.Refresh
        
        Text1.Text = rst.Fields("宿舍号")
        Text2.Text = rst.Fields("物品")
        Text3.Text = rst.Fields("提交日期")
        Text4.Text = rst.Fields("解决日期")
        Text5.Text = rst.Fields("报修原因")
       
End Sub
Private Sub Command2_Click()
        If xian <> 1 Then
            MsgBox "请先点击显示", 0 + 48, "错误提示"
        Else
            rst.MovePrevious
            If rst.BOF = True Then
                rst.MoveLast
            End If
        Text1.Text = rst.Fields("宿舍号")
        Text2.Text = rst.Fields("物品")
        Text3.Text = rst.Fields("提交日期")
        Text4.Text = rst.Fields("解决日期")
        Text5.Text = rst.Fields("报修原因")
       
        End If
        
End Sub
Private Sub Cmddelete_Click()
    If xian <> 1 Then
        MsgBox "请先点击显示", 0 + 48, "错误提示"
    Else
        If Text1.Text = "" Then
            MsgBox "宿舍号不能为空", 0 + 48, "错误提示"
        Else
            If MsgBox(" 确定删除?", 1 + 32, "删除提示") = 1 Then
                Dim SQLstr2 As String
                SQLstr2 = "delete from 学生报修登记表 where 宿舍号 = " & "'" & Text1.Text & "'"
                Set rst = Nothing
                rst.Open SQLstr2, cn, adOpenKeyset, adLockOptimistic
                MsgBox "删除成功!"
                Call cmd_Click
            End If
        End If
    End If
    
End Sub
Private Sub CmdModify_Click()
    Dim SQLstr3 As String
    If xian <> 1 Then
        MsgBox "请先点击显示", 0 + 48, "错误提示"
    Else
        If Text1.Text = "" Then
                    MsgBox "宿舍号不能为空", 0 + 48, "错误提示"
       
                        Else
                            SQLstr3 = "update 学生报修登记表 set " _
                                    & "物品= " & "'" & Text2.Text & "'" _
                                    & "," & "提交日期= " & "'" & Text3.Text & "'" _
                                    & "," & "报修日期= " & "'" & Text4.Text & "'" _
                                    & "," & "报修原因= " & Text5.Text _
                                    & " where 宿舍号 =" & "'" & Text1.Text & "'"
                            Set rst = Nothing
                            rst.Open SQLstr3, cn, adOpenKeyset, adLockOptimistic
                            MsgBox "修改成功!"
                            Call cmd_Click
                        End If
                    End If
     
End Sub
vb 中连接无法用于执行此操作,在此上下文中它可能已被关闭或无效

解决方案 »

  1.   

    Public Function OpenConnection() As Boolean '连接数据库#If Not DebugMode Then
        On Error GoTo errTrap
    #End If    DataServer_Name = "192.168.30.242"
        If Not AdoCn Is Nothing Then Set AdoCn = Nothing
        
        sCnStr = "Provider=SQLOLEDB.1;Persist Security Info=True;Initial Catalog=TY_data_text;User ID=sa;Password=sa;Data Source=" & DataServer_Name & ""
        AdoCn.Open sCnStr
        OpenConnection = True
        AdoCn.Close
        Exit FunctionerrTrap:    MsgBox "数据库联接失败"
        Err.Clear
        OpenConnection = False
    End Function