本人刚刚接触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

解决方案 »

  1.   

    同楼上不过建议使用Update语句对数据表进行修改操作
      

  2.   

    樓主的這本書我以前也買過
    說實在的我就是以這本書開始接觸VB+SQL的
    書中有一定的錯誤,需要自己慢慢修改
      

  3.   

    VB显示If mrc.EOF = False Then(这有错,不能添加考勤信息对象变量WITH块变量未设置)
       mrc.Fields(intCount + 3) = Trim(txtItem(intCount).Text)(这也有错,不能修改考勤信息。类型不匹配)问题就出现在mrc这儿,mrc是记录集,如果出现"对象变量WITH块变量未设置",就说明mrc没有初始化,或没有打开,或记录集为空(没有任何记录).在应用其他对象时也要注意这个问题,最好先"new"一下.
    set mrc=new adodb.recordset还有你的 ExecuteSQL(txtSQL, MsgText)函数能正常执行并返回有效的结果记录集吗?
      

  4.   

    我晕 too长 远远超出我的大脑所能容纳程序的极限 out of memory……