用SQL做后台数据库,有个模块有时能实现,有时出现错误,代码如下,请高手帮忙,怎么回事
Option Explicit '是否改动过记录,ture为改过 Dim mblChange As Boolean Dim mrc As ADODB.Recordset Public txtSQL As String
Private Sub cboItem_Change(Index As Integer) '有变化设置gblchange mblChange = True End Sub
Private Sub cboItem_Click(Index As Integer) Dim sSql As String Dim MsgText As String Dim mrcc As ADODB.Recordset '初始化员工名称和ID If Index = 0 Then txtSQL = "select typename,price from roomtype where typename='" & Trim(cboItem(0)) & "'" Set mrcc = ExecuteSQL(txtSQL, MsgText) If Not mrcc.EOF Then txtItem(2) = mrcc!price cmdSave.Enabled = True Else MsgBox "请先建立客房标准!", vbOKOnly + vbExclamation, "警告" cmdSave.Enabled = False Exit Sub End If mrcc.Close End If Exit Sub End Sub
Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) EnterToTab KeyCode End Sub
Private Sub cmdExit_Click() If mblChange And cmdSave.Enabled Then If MsgBox("保存当前记录的变化吗?", vbOKCancel + vbExclamation, "警告") = vbOK Then '保存 Call cmdSave_Click End If End If Unload Me End Sub
Private Sub cmdSave_Click() Dim intCount As Integer Dim sMeg As String Dim mrcc As ADODB.Recordset Dim MsgText As String For intCount = 0 To 3 If Trim(txtItem(intCount) & " ") = "" Then Select Case intCount Case 0 sMeg = "客房编号" Case 1 sMeg = "客房位置" End Select sMeg = sMeg & "不能为空!" MsgBox sMeg, vbOKOnly + vbExclamation, "警告" txtItem(intCount).SetFocus Exit Sub End If Next intCount If gintRmode = 1 Then txtSQL = "select * from rooms where roomNO='" & Trim(txtItem(0)) & "'" Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = False Then MsgBox "已经存在此客房编号的记录!", vbOKOnly + vbExclamation, "警告" txtItem(0).SetFocus Exit Sub End If mrc.Close End If If gintRmode = 2 Then '先删除已有记录 txtSQL = "delete from rooms where roomNO='" & Trim(txtItem(0)) & "'" Set mrc = ExecuteSQL(txtSQL, MsgText) End If '再加入新记录 txtSQL = "select * from rooms" Set mrc = ExecuteSQL(txtSQL, MsgText) mrc.AddNew mrc.Fields(0) = Trim(txtItem(0)) mrc.Fields(1) = Trim(cboItem(0)) For intCount = 1 To 2 If Trim(txtItem(intCount) & " ") = "" Then mrc.Fields(intCount + 1) = Null Else mrc.Fields(intCount + 1) = Trim(txtItem(intCount)) End If Next intCount mrc.Fields(4) = " " mrc.Fields(5) = Trim(txtItem(3)) mrc.Update mrc.Close If gintRmode = 1 Then For intCount = 0 To 3 txtItem(intCount) = "" Next intCount mblChange = False If flagRedit Then Unload frmRoom frmRoom.txtSQL = "select * from rooms" frmRoom.Show End If ElseIf gintRmode = 2 Then Unload Me If flagRedit Then Unload frmRoom End If frmRoom.txtSQL = "select * from rooms" frmRoom.Show End If End Sub
Private Sub Form_Load() Dim sSql As String Dim intCount As Integer Dim MsgText As String Dim mrcc As ADODB.Recordset If gintRmode = 1 Then Me.Caption = Me.Caption & "添加" '初始化物资名称 txtSQL = "select DISTINCT typename from roomtype" Set mrc = ExecuteSQL(txtSQL, MsgText) If Not mrc.EOF Then Do While Not mrc.EOF cboItem(0).AddItem Trim(mrc.Fields(0)) mrc.MoveNext Loop cboItem(0).ListIndex = 0 Else MsgBox "请先进行客房标准设置!", vbOKOnly + vbExclamation, "警告" cmdSave.Enabled = False Exit Sub End If mrc.Close ElseIf gintRmode = 2 Then Set mrcc = ExecuteSQL(txtSQL, MsgText) If mrcc.EOF = False Then With mrcc txtItem(0) = .Fields(0) For intCount = 1 To 2 If Not IsNull(.Fields(intCount + 1)) Then txtItem(intCount) = .Fields(intCount + 1) End If Next intCount txtItem(3) = .Fields(5) txtSQL = "select DISTINCT typename from roomtype" Set mrc = ExecuteSQL(txtSQL, MsgText) If Not mrc.EOF Then Do While Not mrc.EOF cboItem(0).AddItem Trim(mrc.Fields(0)) mrc.MoveNext Loop cboItem(0).ListIndex = 0 Else MsgBox "请先进行客房标准设置!", vbOKOnly + vbExclamation, "警告" cmdSave.Enabled = False Exit Sub End If mrc.Close End With End If mrcc.Close Me.Caption = Me.Caption & "修改" End If mblChange = False End Sub
Private Sub Form_Unload(Cancel As Integer) gintRmode = 0 End Sub
Private Sub txtItem_Change(Index As Integer) '有变化设置gblchange mblChange = True End Sub
Private Sub txtItem_GotFocus(Index As Integer) txtItem(Index).SelStart = 0 txtItem(Index).SelLength = Len(txtItem(Index)) End Sub
Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) EnterToTab KeyCode
End Sub