本人刚刚接触VB,别人给了一段人事管理系统的源代码但是这段源代码有错误,请高人指教,感激不尽。这段源代码的功能是添加,修改,删除,查找员工考勤信息。
VB显示If mrc.EOF = False Then(这有错,不能添加考勤信息对象变量WITH块变量未设置)
mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)(这也有错,不能修改考勤信息。类型不匹配)Option Explicit
'是否改动过记录,ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As StringPrivate Sub cboItem_Click(Index As Integer)
Dim sSql As String
Dim MsgText As String
If gintMode = 1 Then
'初始化员工名称和ID
txtSQL = "select ygid,ygname from manrecord where ygdept='" & Trim(cboItem(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Index = 0 Then
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
ElseIf Index = 1 Then
mrc.MoveFirst
mrc.Move cboItem(1).ListIndex
txtId = Trim(mrc!ygid)
End If
End If
End SubPrivate Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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
'添加判断是否有相同的ID记录
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(这有错,不能添加考勤信息对象变量WITH块变量未设置)
MsgBox "已经存在该员工在该月的考勤记录!", vbOKOnly + vbExclamation, "警告"
cboMonth.SetFocus
Exit Sub
End If
mrc.Close
End If
'先删除已有记录
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
If gintMode = 1 Then
MsgBox "记录添加成功!", vbOKOnly + vbExclamation, "警告"
For intCount = 0 To 17
txtItem(intCount) = ""
Next intCount
mblChange = False
ElseIf gintMode = 2 Then
MsgBox "记录修改成功!", vbOKOnly + vbExclamation, "警告"
Unload Me
frmCheck.ShowTitle
frmCheck.ShowData
frmCheck.ZOrder 0
End If
gintMode = 0
End SubPrivate Sub Form_Load()
Dim intCount As Integer
Dim dateTemp As Date
Dim MsgText As String
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 manrecord"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboItem(0).AddItem Trim(mrc!ygdept)
mrc.MoveNext
Loop
cboItem(0).ListIndex = 0
Else
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
txtSQL = "select ygdept from manrecord where ygname = '" & Trim(cboItem(1)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
cboItem(0).AddItem Trim(mrc!ygdept)
cboItem(0).ListIndex = 0
mrc.Close
Me.Caption = Me.Caption & "修改"
End If
mblChange = False
End Sub
VB显示If mrc.EOF = False Then(这有错,不能添加考勤信息对象变量WITH块变量未设置)
mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)(这也有错,不能修改考勤信息。类型不匹配)Option Explicit
'是否改动过记录,ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As StringPrivate Sub cboItem_Click(Index As Integer)
Dim sSql As String
Dim MsgText As String
If gintMode = 1 Then
'初始化员工名称和ID
txtSQL = "select ygid,ygname from manrecord where ygdept='" & Trim(cboItem(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Index = 0 Then
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
ElseIf Index = 1 Then
mrc.MoveFirst
mrc.Move cboItem(1).ListIndex
txtId = Trim(mrc!ygid)
End If
End If
End SubPrivate Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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
'添加判断是否有相同的ID记录
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(这有错,不能添加考勤信息对象变量WITH块变量未设置)
MsgBox "已经存在该员工在该月的考勤记录!", vbOKOnly + vbExclamation, "警告"
cboMonth.SetFocus
Exit Sub
End If
mrc.Close
End If
'先删除已有记录
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
If gintMode = 1 Then
MsgBox "记录添加成功!", vbOKOnly + vbExclamation, "警告"
For intCount = 0 To 17
txtItem(intCount) = ""
Next intCount
mblChange = False
ElseIf gintMode = 2 Then
MsgBox "记录修改成功!", vbOKOnly + vbExclamation, "警告"
Unload Me
frmCheck.ShowTitle
frmCheck.ShowData
frmCheck.ZOrder 0
End If
gintMode = 0
End SubPrivate Sub Form_Load()
Dim intCount As Integer
Dim dateTemp As Date
Dim MsgText As String
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 manrecord"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboItem(0).AddItem Trim(mrc!ygdept)
mrc.MoveNext
Loop
cboItem(0).ListIndex = 0
Else
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
txtSQL = "select ygdept from manrecord where ygname = '" & Trim(cboItem(1)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
cboItem(0).AddItem Trim(mrc!ygdept)
cboItem(0).ListIndex = 0
mrc.Close
Me.Caption = Me.Caption & "修改"
End If
mblChange = False
End Sub
說實在的我就是以這本書開始接觸VB+SQL的
書中有一定的錯誤,需要自己慢慢修改
mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)(这也有错,不能修改考勤信息。类型不匹配)问题就出现在mrc这儿,mrc是记录集,如果出现"对象变量WITH块变量未设置",就说明mrc没有初始化,或没有打开,或记录集为空(没有任何记录).在应用其他对象时也要注意这个问题,最好先"new"一下.
set mrc=new adodb.recordset还有你的 ExecuteSQL(txtSQL, MsgText)函数能正常执行并返回有效的结果记录集吗?