大侠们帮我看看这段程序 有错吗？VB+SQL
系统公用模块代码：Public fMainForm As frmmain
Public gintMode As Integer
Public flagEdit As Boolean
Public username As String
Sub Main()
Dim fLogin As New frmlogin
fLogin.Show vbModal
If Not fLogin.OK Then
End
End If
Unload fLogin
Set fMainForm = New frmmain
fMainForm.Show
End Sub
Public Function ExecuteSQL(ByVal SQL _
As String, MsgString As String) _
As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sTokens() As String
On Error GoTo ExecuteSQL_Error
sTokens = Split(SQL)
Set cnn = New ADODB.Connection
cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE", _
UCase$(sTokens(0))) Then
cnn.Execute SQL
MsgString = sTokens(0) & _
" query successful"
Else
Set rst = New ADODB.Recordset
rst.Open Trim$(SQL), cnn, _
adOpenKeyset, _
adLockOptimistic
Set ExecuteSQL = rst
MsgString = "查询到" & rst.RecordCount & _
" 条记录 "
End If
ExecuteSQL_Exit:
Set rst = Nothing
Set cnn = Nothing
Exit Function
ExecuteSQL_Error:
MsgString = "查询错误: " & _
Err.Description
Resume ExecuteSQL_Exit
End Function
Public Function ConnectString() As String
ConnectString = "FileDSN=renshi.dsn"
End Function
员工基本信息模块代码：
Option Explicit
Dim mblchange As Boolean
Public txtSQL As String
Public msgtext As String
Dim mrc As ADODB.Recordset
Private Sub cmdcancle_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim intCount As Integer
Dim txtSQL As String
Dim MsgString As String
Dim sMeg As String
Dim i As Integer
For intCount = 0 To 1
If Trim(Text1(intCount) & "") = "" Then
Select Case intCount
Case 0
sMeg = "工号"
Case 1
sMeg = "姓名"
End Select
sMeg = sMeg & "不能为空"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text1(intCount).SetFocus
Exit Sub
End If
Next intCount
If Trim(Text1(3) & "") = "" Then
MsgBox "出生日期不能为空", vbOKOnly + vbExclamation, "警告"
End If
If Trim(Text1(3) & "") <> "" Then
If Not IsDate(Text1(3)) Then
MsgBox "出生日期应为(yyyy-mm-dd)!", vbOKOnly + vbExclamation, "警告"
Text1(3).SetFocus
Exit Sub
Else
Text1(3) = Format(Text1(3), "yyyy-mm-dd")
End If
End If
If Trim(Text1(2) & "") = "" Then
MsgBox "年龄不能为空", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
If gintMode = 1 Then
txtSQL = "select * from dangan where ygid='" & Trim(Text1(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
MsgBox "有重复记录", vbOKOnly + vbExclamation, "警告"
Text1(0).SetFocus
End If
mrc.Close
txtSQL = "delete * from dangan where ygid='" & Trim(Text1(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
txtSQL = "select * from dangan"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.AddNew
For intCount = 0 To 1
mrc.Fields(intCount) = Trim(Text1(intCount))
Next intCount
For intCount = 2 To 5
mrc.Fields(intCount) = Trim(Text1(intCount))
Next intCount
For intCount = 6 To 10
mrc.Fields(intCount) = Trim(Text1(intCount))
Next intCount
mrc.Fields(11) = Trim(Combo1.Text)
mrc.Update
If gintMode = 1 Then
MsgBox "添加记录成功", vbOKOnly, "提示"
For i = 0 To 10
Text1(i).Text = ""
Next i
frmyuangong.Show
frmyuangong.ZOrder 0
frmmanrecord.ShowTitle
frmmanrecord.ShowData
frmmanrecord.ZOrder 1
End If
ElseIf gintMode = 2 Then
txtSQL = "select * from dangan where ygid='" & Trim(Text1(0).Text) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
For intCount = 0 To 10
mrc.Fields(intCount) = Trim(Text1(intCount))
Next intCount
mrc.Fields(11) = Trim(Combo1.Text)
mrc.Update
MsgBox "修改成功", vbOKOnly, "提示"
Unload Me
frmmanrecord.ShowTitle
frmmanrecord.ShowData
frmmanrecord.ZOrder 0
End If
gintMode = 0
End Sub
Private Sub Form_Load()
Dim msgtext As String
Dim intCount As Integer
With Combo1
.AddItem "男"
.AddItem "女"
End With
If gintMode = 1 Then
Me.Caption = Me.Caption & "添加"
Combo1.ListIndex = 0
ElseIf gintMode = 2 Then
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
With mrc
For intCount = 0 To 10
Text1(intCount) = .Fields(intCount)
Next intCount
If Not IsNull(!易做图) Then
Combo1 = !易做图
End If
mrc.Close
Me.Caption = Me.Caption & "修改"
End With
End If
End If
mblchange = False
End Sub
Option Explicit
Public sQSql As String
Public mrc As ADODB.Recordset
Public txtSQL As String
Public msgtext As String
Private Sub Check1_Click(Index As Integer)
If Index = 0 Then
Text1(Index).SetFocus
End If
If Index = 1 Then
Text1(Index).SetFocus
Else
Text1(Index).SetFocus
End If
End Sub
Private Sub cmdcancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
If Check1(0).Value = vbChecked Then
sQSql = "ygname='" & Trim(Text1(0) & "") & "'"
End If
If Check1(1).Value = vbChecked Then
If Trim(sQSql & " ") = "" Then
sQSql = "ygid='" & Trim(Text1(1) & "") & "'"
Else
sQSql = sQSql & "and ygid='" & Trim(Text1(1) & "") & "'"
End If
End If
If Check1(2).Value = vbChecked Then
If Trim(sQSql & " ") = "" Then
sQSql = "ygdept='" & Trim(Text1(2) & "") & ""
Else
sQSql = sQSql & "and ygdept='" & Trim(Text1(2) & "") & "'"
End If
End If
If Trim(sQSql & " ") = "" Then
frmmanrecord.txtSQL = "select * from dangan"
flagEdit = True
frmmanrecord.ShowTitle
frmmanrecord.ShowData
frmmanrecord.Show
Else
frmmanrecord.txtSQL = "select * from dangan where " & sQSql
flagEdit = True
frmmanrecord.ShowTitle
frmmanrecord.ShowData
frmmanrecord.Show
End If
Me.Hide
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 0 To 2
Text1(i) = ""
Next
End Sub
--------------------编程问答-------------------- 员工考勤模块代码：
Option Explicit
Dim mblchange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String
Private Sub cboItem_Click(Index As Integer)
Dim msgtext As String
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.MoveFirst
mrc.Move cboItem(1).ListIndex
txtid = Trim(mrc!ygid)
End Sub
Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub cboMonth_Click()
Dim dateTemp As Date
dateTemp = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(cboYear), CInt(cboMonth), 1)))
txtItem(0) = Day(dateTemp)
End Sub
Private Sub cboYear_Click()
Dim dateTemp As Date
If Trim(cboMonth & " ") <> "" Then
dateTemp = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(cboYear), CInt(cboMonth), 1)))
txtItem(0) = Day(dateTemp)
End If
End Sub
Private Sub cmdExit_Click()
If mblchange And gintMode <> 3 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 rectemp As Recordset
Dim sSql As String
Dim msgtext As String
For intCount = 0 To 3
If Trim(txtItem(intCount) & " ") = "" Then
Select Case intCount
Case 0
sMeg = "本月天数"
Case 2
sMeg = "应出勤天数"
Case 3
sMeg = "出勤"
End Select
If intCount <> 1 Then
sMeg = sMeg & "不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
txtItem(intCount).SetFocus
Exit Sub
End If
End If
Next intCount
If gintMode = 1 Then
txtSQL = "select * from checkin where kqid='" & Trim(txtid) & "' and kqdate= '" & Format(cboYear.Text & "-" & cboMonth.Text & "-01", "yyyy-mm-dd") & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
MsgBox "已经存在该员工在该月的考勤记录！", vbOKOnly + vbExclamation, "警告"
cboMonth.SetFocus
Exit Sub
End If
mrc.Close
txtSQL = "delete from checkin where kqid='" & Trim(txtid) & "' and kqdate='" & Format(cboYear & "-" & cboMonth & "-01", "yyyy-mm-dd") & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
txtSQL = "select * from checkin"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.AddNew
mrc.Fields(0) = Trim(txtid)
mrc.Fields(1) = Trim(cboItem(1))
mrc.Fields(2) = Format(cboYear & "-" & cboMonth & "-01", "yyyy-mm-dd")
For intCount = 0 To 15
mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)
Next intCount
For intCount = 16 To 17
mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)
Next intCount
mrc.Update
MsgBox "记录添加成功！", vbOKOnly + vbExclamation, "警告"
For intCount = 0 To 17
txtItem(intCount) = ""
Next intCount
mblchange = False
ElseIf gintMode = 2 Then
txtSQL = "select kqid,kqname,kqdays,kqrday,kqtday,kqwork,kqabsent,kqrest,kqleave,kqlate,kqearly,kqforget,kqover1,kqvoer2,kqfill,kqgo,kqpay,kqdeduct,kqother,kqremark from checkin where kqid='" & Trim(txtid) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.Fields(0) = Trim(txtid)
mrc.Fields(1) = Trim(cboItem(1))
For intCount = 0 To 15
mrc.Fields(intCount + 2) = Trim(txtItem(intCount).Text)
Next intCount
For intCount = 16 To 17
mrc.Fields(intCount + 2) = Trim(txtItem(intCount).Text)
Next intCount
mrc.Update
MsgBox "记录修改成功!", vbOKOnly, "提示"
mrc.Close
Unload Me
frmCheck.ShowTitle
frmCheck.ShowData
frmCheck.ZOrder 0
End If
gintMode = 0
End Sub
Private Sub DataCombo1_Click(Area As Integer)
Dim sSql As String
Dim msgtext As String
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
cboItem(1).Clear
If Not mrc.EOF Then
With cboItem(1)
Do While Not mrc.EOF
.AddItem Trim(mrc!ygname)
mrc.MoveNext
Loop
.ListIndex = 0
End With
cmdSave.Enabled = True
Else
MsgBox "请先建立员工档案！", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
End Sub
Private Sub Form_Load()
Dim intCount As Integer
Dim dateTemp As Date
Dim msgtext As String
Adodc1.Visible = False
cboYear.AddItem Year(Now)
cboYear.AddItem Year(Now) - 1
cboYear.ListIndex = 0
For intCount = 1 To 12
cboMonth.AddItem intCount
Next intCount
cboMonth = Month(Now)
If gintMode = 1 Then
Me.Caption = Me.Caption & "添加"
'初始化部门名称
txtSQL = "select DISTINCT ygdept from dangan"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF Then
MsgBox "请先进行员工档案登记！", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
'初始化本月天数
dateTemp = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(cboYear), CInt(cboMonth), 1)))
txtItem(0) = Day(dateTemp)
mrc.Close
ElseIf gintMode = 2 Then
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
With mrc
cboItem(1).AddItem .Fields(1)
cboItem(1).ListIndex = 0
For intCount = 2 To 19
If Not IsNull(.Fields(intCount)) Then
txtItem(intCount - 2) = .Fields(intCount)
End If
Next intCount
txtid = .Fields(0)
End With
End If
mrc.Close
Me.Caption = Me.Caption & "修改"
End If
mblchange = False
End Sub
--------------------编程问答-------------------- 员工评价模块代码：
Option Explicit
Dim mblchange As Boolean
Public txtSQL As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
Private Sub cmdcancel_Click()
If mblchange And cmdok.Enabled Then
If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
'保存
Call cmdOK_Click
End If
End If
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim intCount As Integer
Dim sMeg As String
Dim sSql As String
If Trim(Text2 & "") = "" Then
sMeg = "时间"
sMeg = sMeg & "不能为空"
MsgBox sMeg, vbOKOnly + vbExclamation, "提示"
Text2.SetFocus
End If
If Trim(Text2 & "") <> "" Then
If Not IsDate(Text2) Then
MsgBox "输入日期应为yyyy-mm-dd!", vbOKOnly + vbExclamation, "警告"
Text2.SetFocus
Exit Sub
Else
Text2 = Format(Text2, "yyyy-mm-dd")
End If
End If
If gintMode = 1 Then
txtSQL = "select * from pingjia where pjid='" & Trim(Text1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
MsgBox "己有此编号记录!", vbOKOnly, "提示"
txtSQL = "delete from pingjia where pjid='" & Trim(Text1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
txtSQL = "select * from pingjia"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.AddNew
mrc.Fields(6) = DataCombo1
mrc.Fields(1) = Combo(1)
For intCount = 0 To 3
mrc.Fields(intCount + 2) = Trim(Text(intCount))
Next intCount
mrc.Fields(7) = Trim(Text2.Text)
mrc.Fields(0) = Trim(Text1)
mrc.Update
mrc.Close
MsgBox "添加记录成功！", vbOKOnly + vbExclamation, "提示"
For intCount = 0 To 3
Text(intCount) = ""
Next intCount
Text2 = GetNo
ElseIf gintMode = 2 Then
txtSQL = "select * from pingjia where pjid='" & Trim(Text1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.Fields(6) = DataCombo1
mrc.Fields(1) = Combo(1)
For intCount = 0 To 3
mrc.Fields(intCount + 2) = Trim(Text(intCount))
Next intCount
mrc.Fields(7) = Trim(Text2.Text)
mrc.Fields(0) = Trim(Text1)
mrc.Update
mrc.Close
MsgBox "修改记录成功！", vbOKOnly + vbExclamation, "提示"
frmpjchange.ShowTitle
frmpjchange.ShowData
frmpjchange.ZOrder 0
gintMode = 0
mblchange = False
End If
Exit Sub
End Sub
Private Sub Combo_Click(Index As Integer)
Dim msgtext As String
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.MoveFirst
mrc.Move Combo(1).ListIndex
Text1 = Trim(mrc!ygid)
End Sub
Private Sub DataCombo1_Click(Area As Integer)
Dim sSql As String
Dim msgtext As String
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
Combo(1).Clear
If Not mrc.EOF Then
With Combo(1)
Do While Not mrc.EOF
.AddItem Trim(mrc!ygname)
mrc.MoveNext
Loop
.ListIndex = 0
End With
cmdok.Enabled = True
Text2 = Format(Now, "yyyy-mm-dd")
Else
MsgBox "请先建立员工档案！", vbOKOnly + vbExclamation, "警告"
cmdok.Enabled = False
Exit Sub
End If
End Sub
Private Sub Form_Load()
Dim msgtext As String
Dim intCount As Integer
Adodc1.Visible = False
If gintMode = 1 Then
Me.Caption = Me.Caption & "添加"
Text1 = GetNo
'初始化部门名称
txtSQL = "select DISTINCT ygdept from dangan"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If Not mrc.EOF Then
Else
MsgBox "请先进行员工档案登记！", vbOKOnly + vbExclamation, "警告"
cmdok.Enabled = False
Exit Sub
End If
ElseIf gintMode = 2 Then
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
With mrc
Combo(1).AddItem .Fields(1)
Combo(1).ListIndex = 0
For intCount = 2 To 5
If Not IsNull(.Fields(intCount + 2)) Then
Text(intCount - 2) = .Fields(intCount)
Text1 = .Fields(0)
Text2 = .Fields(7)
End If
Next intCount
End With
End If
If gintMode = 3 Then
cmdok.Enabled = False
Me.Caption = Me.Caption & "内容"
Else
Me.Caption = Me.Caption & "修改"
End If
End If
mblchange = False
End Sub
Private Sub Text_Change(Index As Integer)
mblchange = True
End Sub
--------------------编程问答-------------------- 好长啊 你可以 调试下 哪里错了 这样看起来容易点~ --------------------编程问答-------------------- 员工工资模块代码：
Option Explicit
Dim mrc As Recordset
Public txtSQL As String
Dim msgtext As String
Dim mblchange As Boolean
Private Sub cmdcp_Click()
Text(9) = Str(Val(Text(2)) + Val(Text(3)) + Val(Text(4)) + Val(Text(5)) - Val(Text(6)) - Val(Text(7)) - Val(Text(8)))
End Sub
Private Sub cmdOK_Click()
Dim intCount As Integer
Dim sMeg As String
Dim rectemp As Recordset
Dim msgtext As String
Dim txtSQL As String
If Trim(Text(2) & "") = "" Then
sMeg = "底薪"
sMeg = sMeg & "不能为空"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text(2).SetFocus
Exit Sub
End If
If Trim(Text(1) & "") <> "" Then
If Not IsDate(Text(1)) Then
MsgBox "输入日期格式不正确，应为(yyyy-mm-dd)!", vbOKOnly + vbExclamation, "警告"
Text(1).SetFocus
Exit Sub
End If
If gintMode = 1 Then
txtSQL = "select * from gongzi where gzid='" & Trim(Text(0)) & "' "
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
MsgBox "已经存在该员工在该月的工资记录！", vbOKOnly + vbExclamation, "警告"
Text(1).SetFocus
Exit Sub
End If
mrc.Close
End If
txtSQL = "delete from gongzi where gzid='" & Trim(Text(0)) & "' and month1='" & Format(Text(1), "yyyy-mm-dd") & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
txtSQL = "select * from gongzi"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.AddNew
mrc.Fields(0) = Trim(Text(0))
mrc.Fields(1) = Trim(Combo(1))
For intCount = 2 To 9
mrc.Fields(intCount) = Trim(Text(intCount))
Next intCount
mrc.Fields(10) = Trim(Text(1))
mrc.Update
mrc.Close
MsgBox "计发工资成功！", vbOKOnly + vbExclamation, "提示"
For intCount = 0 To 9
Text(intCount) = ""
Next intCount
mblchange = False
cmdok.Enabled = False
frmgzchange.txtSQL = "select * from gongzi"
frmgzchange.ShowTitle
frmgzchange.ShowData
frmgzchange.ZOrder 1
ElseIf gintMode = 2 Then
MsgBox "修改工资成功！", vbOKOnly + vbExclamation, "警告"
Unload Me
frmgzchange.txtSQL = "select * from gongzi"
frmgzchange.ShowTitle
frmgzchange.ShowData
frmgzchange.ZOrder 0
End If
End Sub
Private Sub Combo_Click(Index As Integer)
Dim msgtext As String
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.MoveFirst
mrc.Move Combo(1).ListIndex
Text(0) = Trim(mrc!ygid)
End Sub
Private Sub combo_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub cmdcancel_Click()
If mblchange And cmdok.Enabled Then
If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
Call cmdOK_Click
End If
End If
Unload Me
End Sub
Private Sub DataCombo1_Click(Area As Integer)
Dim sSql As String
Dim msgtext As String
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
Combo(1).Clear
If Not mrc.EOF Then
With Combo(1)
Do While Not mrc.EOF
.AddItem Trim(mrc!ygname)
mrc.MoveNext
Loop
.ListIndex = 0
End With
cmdok.Enabled = True
Else
MsgBox "请先建立员工档案！", vbOKOnly + vbExclamation, "警告"
cmdok.Enabled = False
Exit Sub
End If
End Sub
Private Sub Form_Load()
Dim msgtext As String
Dim intCount As Integer
Dim dateTemp As Date
Adodc1.Visible = False
If gintMode = 1 Then
Me.Caption = Me.Caption & "添加"
Text(1) = Format(Now, "yyyy-mm-dd")
txtSQL = "select ygid,ygname from dangan where ygdept='" & Trim(DataCombo1) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
With mrc
Combo(1).AddItem Trim(mrc!ygname)
Combo(1).ListIndex = 0
Text(0) = .Fields(0)
End With
End If
Me.Caption = Me.Caption & "修改"
ElseIf gintMode = 2 Then
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
With mrc
Combo(1).AddItem .Fields(1)
Combo(1).ListIndex = 0
For intCount = 2 To 9
If Not IsNull(.Fields(intCount)) Then
Text(intCount) = .Fields(intCount)
End If
Next intCount
Text(0) = .Fields(0)
Text(1) = .Fields(10)
End With
End If
mrc.Close
End If
mblchange = False
End Sub
人事变动管理模块代码：
Option Explicit
Dim mblchange As Boolean
Public txtSQL As String
Public msgtext As String
Dim mrc As ADODB.Recordset
Dim mybookmark As Variant
Private Sub cmdcancel_Click()
Unload Me
End Sub
Private Sub cmdchange_Click()
cmdchange.Enabled = False
Command1.Enabled = False
cmddelete.Enabled = False
gintMode = 2
End Sub
Private Sub cmddelete_Click()
Dim st As String
mybookmark = mrc.Bookmark
st = MsgBox("是否删除当前记录?", vbOKCancel, "提示")
If st = vbOK Then
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
mybookmark = mrc.Bookmark
mrc.MoveLast
mrc.Delete
mybookmark = mrc.Bookmark
Call viewdata
Else
mybookmark = mrc.Bookmark
mrc.MovePrevious
mrc.Delete
mrc.Bookmark = mybookmark
Call viewdata
End If
Else
mrc.Bookmark = mybookmark
Call viewdata
End If
End Sub
Private Sub cmdOK_Click()
Dim intCount As Integer
Dim txtSQL As String
Dim MsgString As String
If Text(0) = "" Then
MsgBox "编号不能为空!", vbOKOnly + vbExclamation, "警告"
Text(0).SetFocus
End If
If Text(1) = "" Then
MsgBox "事件不能为空!", vbOKOnly + vbExclamation, "警告"
Text(1).SetFocus
End If
If gintMode = 1 Then
txtSQL = "select * from renshi1 where id='" & Trim(Text(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
MsgBox "己存在此编号的记录,请重新输入!", vbOKOnly + vbExclamation, "警告"
Text(0).SetFocus
Exit Sub
End If
mrc.Close
txtSQL = "delete * from renshi1 where id='" & Trim(Text(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
txtSQL = "select * from renshi1"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.AddNew
For intCount = 0 To 2
mrc.Fields(intCount) = Trim(Text(intCount))
Next intCount
mrc.Update
MsgBox "添加记录成功!", vbOKOnly, "提示"
frmrenshi.ZOrder 1
frmrenshi.Show
Command1.Enabled = True
cmdchange.Enabled = True
cmddelete.Enabled = True
first.Enabled = True
previous.Enabled = True
next1.Enabled = True
last.Enabled = True
End If
If gintMode = 2 Then
txtSQL = "select * from renshi1"
Set mrc = ExecuteSQL(txtSQL, msgtext)
For intCount = 0 To 2
mrc.Fields(intCount) = Text(intCount).Text
Next intCount
mrc.Update
MsgBox "记录修改成功!", vbOKOnly, "提示"
cmdchange.Enabled = True
Command1.Enabled = True
cmddelete.Enabled = True
End If
gintMode = 0
End Sub
Private Sub Command1_Click()
Dim i As Integer
For i = 0 To 2
Text(i).Text = ""
Next i
Command1.Enabled = False
cmdchange.Enabled = False
cmddelete.Enabled = False
first.Enabled = False
previous.Enabled = False
next1.Enabled = False
last.Enabled = False
gintMode = 1
End Sub
Private Sub first_Click()
mrc.MoveFirst
Call viewdata
End Sub
Private Sub Form_Load()
Dim txtSQL As String
Dim msgtext As String
Dim i As Integer
txtSQL = "select * from renshi1 "
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = True Then
MsgBox "没有任何记录,请添加!", vbOKOnly, "提示"
Else
mrc.MoveFirst
Call viewdata
mybookmark = mrc.Bookmark
mblchange = True
End If
mblchange = True
End Sub
Private Sub next1_Click()
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
End If
Call viewdata
End Sub
Private Sub previous_Click()
mrc.MovePrevious
If mrc.BOF Then
mrc.MoveLast
End If
Call viewdata
End Sub
Public Sub viewdata()
Dim intCount As Integer
For intCount = 0 To 2
Text(intCount) = mrc.Fields(intCount)
Next intCount
End Sub
部门管理模块代码：
Private Sub Form_Load()
Dim txtSQL As String
Dim msgtext As String
txtSQL = "select * from department"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = True Then
MsgBox "没有任何记录,记添加!", vbOKOnly, "提示"
Else
mrc.MoveFirst
Call viewdata
mybookmark = mrc.Bookmark
mblchange = True
End If
If gintMode = 1 Then
Me.Caption = Me.Caption & "添加"
End If
End Sub
Public Sub viewdata()
Dim intCount As Integer
For intCount = 0 To 2
Text(intCount) = mrc.Fields(intCount)
Next intCount
End Sub
Private Sub cmdchange_Click()
Dim intCount As Integer
Dim txtSQL As String
Dim msgtext As String
Dim sMeg As String
Dim i As Integer
If cmdchange.Caption = "保存" Then
For intCount = 0 To 2
If Trim(Text(intCount) & " ") = "" Then
Select Case intCount
Case 0
sMeg = "编号"
Case 1
sMeg = "名称"
Case 3
sMeg = "经理"
End Select
sMeg = sMeg & "不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text(intCount).SetFocus
Exit Sub
End If
Next intCount
If gintMode = 1 Then
txtSQL = "select * from department where dpid='" & Trim(Text(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = False Then
MsgBox "已经存在此档案编号的记录！", vbOKOnly + vbExclamation, "警告"
Text(0).SetFocus
Text(0).SelStart = 0
Text(0).SelLength = Len(Text(0))
Exit Sub
End If
mrc.Close
End If
txtSQL = "select * from department"
Set mrc = ExecuteSQL(txtSQL, msgtext)
mrc.AddNew
For intCount = 0 To 2
mrc.Fields(intCount) = Trim(Text(intCount))
Next intCount
mrc.Update
MsgBox "记录添加成功！", vbOKOnly + vbExclamation, "警告"
cmdok.Enabled = True
cmdchange.Caption = "修改"
For i = 0 To 2
Text(i).Text = ""
mblchange = False
Next i
frmbumen.Show
frmbumen.ZOrder 0
ElseIf cmdchange.Caption = "修改" Then
txtSQL = "select * from department where dpid='" & Trim(Text(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
For i = 0 To 2
mrc.Fields(i) = Text(i).Text
Next i
mrc.Update
For intCount = 0 To 2
Text(intCount).Enabled = True
mybookmark = mrc.Bookmark
Next intCount
MsgBox "记录修改成功！", vbOKOnly + vbExclamation, "警告"
Unload Me
End If
End Sub
--------------------编程问答--------------------
mrc定义 错了
ExecuteSQL(txtSQL, msgtext)
--------------------编程问答-------------------- 贴代码没有用
你的缺少文件
vb版本换了吗？ --------------------编程问答--------------------
补充：VB , 控件
