frmemployee.frm

人事资源管理系统

Call getcboDutyId  '获取DutyId
Call getcboNationId  '获取NationId
Call getcboEduId  '获取EduId
'检验此用户名是否已经存在
txtTest = "select EmpId from tbEmployee where EmpId ='" + Trim(txtId.Text) + "'"
If DBExist(txtTest) <> 0 Then
    MsgBox "职员编号重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
    txtId.BackColor = BLUE
Else
    txtSQL = "insert into tbEmployee(EmpId,EmpName,Gender,Age,NationId,Birthday,PoliticalParty,MaritalCon,"
    txtSQL = txtSQL + "DepId , HireDate, EduId, FamilyPlace, IdCard, Email, Officephone, Homephone, Mobile,"
    txtSQL = txtSQL + "State , Residence, Postcode, DutyId, RecorId,PRLocation,EmpIdRecord)"
    txtSQL = txtSQL + "values('" + Trim(txtId.Text) + "','" + Trim(txtName.Text) + "','" + Trim(cboSex.Text)
    txtSQL = txtSQL + "','" + Trim(txtAge.Text) + "','" + Trim(strNation) + "','" + Trim(dateBirth)
    txtSQL = txtSQL + "','" + Trim(cboPolitic.Text) + "','" + Trim(cboMerry.Text) + "','" + Trim(strDepId)
    txtSQL = txtSQL + "','" + Trim(txtInComp.Text) + "','" + Trim(strEdu) + "','" + Trim(txtPR.Text)
    txtSQL = txtSQL + "','" + Trim(txtIndentityId.Text) + "','" + Trim(txtEmail.Text) + "','" + Trim(txtTelOffice.Text)
    txtSQL = txtSQL + "','" + Trim(txtTelHome.Text) + "','" + Trim(txtTelMobile.Text) + "','" + Trim(cboState.Text)
    txtSQL = txtSQL + "','" + Trim(txtHomeAddress.Text) + "','" + Trim(txtCode.Text) + "','" + Trim(strPosition)
    txtSQL = txtSQL + "','" + Trim(txtRecordId.Text) + "','" + Trim(txtLocation.Text) + "','" + Trim(txtId.Text) + "')"
    result = ExecuteSQL(txtSQL, rstEmployee, True)
    MsgBox "添加成功！", vbOKOnly + vbExclamation, "警告"
    Call viewDataEmp '刷新表格中的数据
End If
End Sub
Private Sub cmdDel_Click()
Dim txtSQLDelFamily As String
Dim txtSQLDelWorkExp As String
Dim txtSQLDelEdu As String
Dim txtSQLDelChangeDep As String
Dim txtSQLDelRecord As String
Dim txtSQLDelEvaluation As String
'检验删除记录是否选定
If txtIsNull(txtId) Then
    MsgBox "请选择删除的记录！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
End If
'提示警告信息
str = MsgBox("是否删除当前记录？", vbOKCancel, "删除当前记录")
If str = vbOK Then
    txtTest = "select EmpId from tbEmployee where EmpId ='" + Trim(txtId.Text) + "'"
    '检验此用户名是否已经存在
    If DBExist(txtTest) = 0 Then
        MsgBox "无此用户！", vbOKOnly + vbExclamation, "警告"
        txtId.BackColor = BLUE
    Else
        txtSQL = "delete from tbEmployee where EmpId='" + Trim(txtId.Text) + "'"
        result = ExecuteSQL(txtSQL, rstEmployee, True)
        '删除tbFamilyMember中该员工记录
        txtSQLDelFamily = "delete from tbFamilyMember where EmpId='" + Trim(txtId.Text) + "'"
        result = ExecuteSQL(txtSQLDelFamily, rstEmployee, True)
        '删除tbWorkExp中该员工记录
        txtSQLDelWorkExp = "delete from tbWorkExp where EmpId='" + Trim(txtId.Text) + "'"
        result = ExecuteSQL(txtSQLDelWorkExp, rstEmployee, True)
        '删除tbWorkRecord中该员工记录
        txtSQLDelRecord = "delete from tbWorkRecord where EmpId='" + Trim(txtId.Text) + "'"
        result = ExecuteSQL(txtSQLDelRecord, rstEmployee, True)
        '删除tbEvaluation中该员工记录
        txtSQLDelEvaluation = "delete from tbEvaluation where EmpId='" + Trim(txtId.Text) + "'"
        result = ExecuteSQL(txtSQLDelEvaluation, rstEmployee, True)
        MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
        Call Clear  '清空画面各个显示值
        Call viewDataEmp '刷新表格中的数据
    End If
End If
End Sub
Private Sub cmdFamily_Click()
If Trim(txtId.Text) = "" Then
    MsgBox "请选择职员！", vbOKOnly + vbExclamation, "警告"
Else
    gEmployeeId = txtId.Text
    frmFamily.Show
End If
End Sub
Private Sub cmdModify_Click()
If checkIn = False Then '检验输入值
Exit Sub
End If
Call getcboDepId '获取DepId
Call getcboDutyId  '获取DutyId
Call getcboNationId  '获取NationId
Call getcboEduId  '获取EduId
txtTest = "select EmpId from tbEmployee where EmpId ='" + Trim(txtId.Text) + "'"
If DBExist(txtTest) = 0 Then
    MsgBox "职员不存在，请重新输入或者点击添加按钮！", vbOKOnly + vbExclamation, "警告"
    txtId.BackColor = BLUE
Else
    txtSQL = "update tbEmployee set EmpId = '" + Trim(Me.txtId.Text) + "',EmpName = '" + Trim(Me.txtName.Text)
    txtSQL = txtSQL + "',Gender = '" + Trim(Me.cboSex.Text) + "' ,Age = '" + Trim(Me.txtAge.Text)
    txtSQL = txtSQL + "',NationId = '" + strNation + "' ,Birthday = '" + Trim(Me.txtBirth.Text)
    txtSQL = txtSQL + "',PoliticalParty = '" + Trim(Me.cboPolitic.Text) + "' ,MaritalCon = '" + Trim(Me.cboMerry.Text)
    txtSQL = txtSQL + "',DepId = '" + strDepId + "' ,HireDate = '" + Trim(Me.txtInComp.Text)
    txtSQL = txtSQL + "',EduId = '" + strEdu + "' ,FamilyPlace = '" + Trim(Me.txtPR.Text)
    txtSQL = txtSQL + "',IdCard = '" + Trim(Me.txtIndentityId.Text) + "' ,Email = '" + Trim(Me.txtEmail.Text)
    txtSQL = txtSQL + "',Officephone = '" + Trim(Me.txtTelOffice.Text) + "' ,Homephone = '" + Trim(Me.txtTelHome.Text)
    txtSQL = txtSQL + "',Mobile = '" + Trim(Me.txtTelMobile.Text) + "' ,State = '" + Trim(Me.cboState.Text)
    txtSQL = txtSQL + "',Residence = '" + Trim(Me.txtHomeAddress.Text) + "' ,Postcode = '" + Trim(Me.txtCode.Text)
    txtSQL = txtSQL + "',DutyId = '" + strPosition + "' ,RecorId = '" + Trim(Me.txtRecordId.Text)
    txtSQL = txtSQL + "',PRLocation = '" + Trim(Me.txtLocation.Text) + "' ,EmpIdRecord = '" + Trim(Me.txtId.Text)
    txtSQL = txtSQL + "' where EmpId='" + Trim(txtId.Text) + "'"
    result = ExecuteSQL(txtSQL, rstEmployee, True)
    MsgBox " 修改成功！", vbOKOnly + vbExclamation, "警告"
    Call viewDataEmp
End If
End Sub
Private Sub cmdRetrieve_Click()
If txtInComFrom.Text <> "" Then
    If IsDate(txtInComFrom.Text) Then
        dateRetrieveFrom = CDate(txtInComFrom.Text)
    Else
        MsgBox "日期类型输入不正确，应该为yyyy-mm-dd", vbOKOnly + vbExclamation, "警告"
        txtInComFrom.SetFocus
        txtInComFrom.BackColor = BLUE
        Exit Sub
    End If
End If
If txtInComUntil.Text <> "" Then
    If IsDate(txtInComUntil.Text) Then
        dateRetrieveTo = CDate(txtInComUntil.Text)
    Else
        MsgBox "日期类型输入不正确，应该为yyyy-mm-dd", vbOKOnly + vbExclamation, "警告"
        txtInComUntil.SetFocus
        txtInComUntil.BackColor = BLUE
        Exit Sub
    End If
End If
If getcboRetriDepId = False Then
    Exit Sub
End If
If getcboRetriEduId = False Then
    Exit Sub
End If
    '检索所有的信息
    txtSQL = "select a.EmpId as 职员编号,a.EmpName as 职员姓名,a.Gender as 性别,a.Age as 年龄,"
    txtSQL = txtSQL & "b.NationName as 民族,a.Birthday as 出生日期,a.PoliticalParty as 政治面貌,a.MaritalCon as 婚姻状况,"
    txtSQL = txtSQL & "c.DepName as 所在部门 , a.HireDate as 入职时间, e.EduName as 学历, a.FamilyPlace as 籍贯,"
    txtSQL = txtSQL & "a.IdCard as 身份证号, a.Email as 电子邮箱, a.Officephone as 办公室电话, a.Homephone as 家庭电话,"
    txtSQL = txtSQL & "a.Mobile as 手机,a.State as 职员类型, a.Residence as 住址, a.Postcode as 邮政编码, d.DutyName as 职务,"
    txtSQL = txtSQL & "a.RecorId as 档案号码,a.PRLocation as 户口多在地,a.EmpIdRecord as 信息录入员编号 "
    txtSQL = txtSQL & "from  (tbEmployee a left join tbDep c on a.DepId=c.DepId) "
    txtSQL = txtSQL & "left join tbDuty d on a.DutyId=d.DutyId, tbNation b ,tbEdu as e "
    txtSQL = txtSQL & "where a.NationId=b.NationId and e.EduId=a.EduId"
If Me.txtInComFrom.Text <> "" Then
    txtSQL = txtSQL + " and a.HireDate >= '" + CStr(dateRetrieveFrom) + "'"
End If
If Me.txtInComUntil.Text <> "" Then
    txtSQL = txtSQL + " and a.HireDate <= '" + CStr(dateRetrieveTo) + "'"
End If
If cboRetrieveEdu.Text <> "" Then
    txtSQL = txtSQL + " and a.EduId = '" + strRetriveEduId + "'"
End If
If Me.cboRetriveDep.Text <> "" Then
    If Mid(strRetriveDepId, 3, 4) = "0000" Then
        txtSQL = txtSQL + " and substring(a.DepId,1,2) = '" + Mid(strRetriveDepId, 1, 2) + "'"
    Else
        If Mid(strRetriveDepId, 5, 2) = "00" Then
          txtSQL = txtSQL + " and substring(a.DepId,1,4) = '" + Mid(strRetriveDepId, 1, 4) + "'"
        Else
          txtSQL = txtSQL + " and a.DepId = '" + strRetriveDepId + "'"
        End If
    End If
End If
    txtSQL = txtSQL & "  order by a.EmpId"
    Set dgEmp.DataSource = Nothing
    result = viewData(txtSQL, dgEmp)
    Me.StatusBar1.Panels(1).Text = "共有" + CStr(result) + "条记录"
    Me.StatusBar1.Panels(1).Alignment = 1
End Sub
Private Sub cmdWork_Click()
gEmployeeId = txtId.Text
frmWorkExp.Show '弹出工作经历窗体
End Sub
Private Sub cmQuit_Click()
Unload Me
End Sub
Private Sub dgEmp_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
'dg的RowColChange事件，用来获取鼠标点击到的dg的单元格
If results <> 0 Then
    Me.txtId.Text = dgEmp.Columns(0).Text
    Me.txtName.Text = dgEmp.Columns(1).Text
    Me.cboSex.Text = dgEmp.Columns(2).Text
    Me.txtAge.Text = dgEmp.Columns(3).Text
    Me.cboNation.Text = dgEmp.Columns(4).Text
    Me.txtBirth.Text = dgEmp.Columns(5).Text
    Me.cboPolitic.Text = dgEmp.Columns(6).Text
    Me.cboMerry.Text = dgEmp.Columns(7).Text
    Me.cboDep.Text = dgEmp.Columns(8).Text
    Me.txtInComp.Text = dgEmp.Columns(9).Text
    Me.cboEdu.Text = dgEmp.Columns(10).Text
    Me.txtPR.Text = dgEmp.Columns(11).Text
    Me.txtIndentityId.Text = dgEmp.Columns(12).Text
    Me.txtEmail.Text = dgEmp.Columns(13).Text
    Me.txtTelOffice.Text = dgEmp.Columns(14).Text
    Me.txtTelHome.Text = dgEmp.Columns(15).Text
    Me.txtTelMobile.Text = dgEmp.Columns(16).Text
    Me.cboState.Text = dgEmp.Columns(17).Text
    Me.txtHomeAddress.Text = dgEmp.Columns(18).Text
    Me.txtCode.Text = dgEmp.Columns(19).Text
    Me.cboPosition.Text = dgEmp.Columns(20).Text
    Me.txtRecordId.Text = dgEmp.Columns(21).Text
    Me.txtLocation.Text = dgEmp.Columns(22).Text
End If
End Sub
' ******************************************************************************
'过程名：cboDep
'说  明：为cboDep赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboDepData()
Dim txtDep As String
Dim resDep As String
txtDep = "select DepId,DepName from tbDep"
resDep = cboData(txtDep, cboDep)
End Sub
' ******************************************************************************
'过程名：cboDepDataRetre
'说  明：为cboRetriveDep赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboDepDataRetre()
Dim txtDep As String
Dim resDep As String
txtDep = "select DepId,DepName from tbDep"
resDep = cboData(txtDep, cboRetriveDep)
End Sub
' ******************************************************************************
'过程名：cboNation
'说  明：为cboNation赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboNationData()
Dim txtNation As String
Dim resNation As String
txtNation = "select NationId,NationName from tbNation"
resNation = cboData(txtNation, cboNation)
End Sub
' ******************************************************************************
'过程名：cboEduData
'说  明：为cboEdu赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboEduData()
Dim txtEdu As String
Dim resEdu As String
txtEdu = "select EduId,EduName from tbEdu"
resEdu = cboData(txtEdu, cboEdu)
End Sub
' ******************************************************************************
'过程名：cboRerieveEduData
'说  明：为cmdRetrieveEdu赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboRerieveEduData()
Dim txtEdu As String
Dim resEdu As String
txtEdu = "select EduId,EduName from tbEdu"
resEdu = cboData(txtEdu, cboRetrieveEdu)
End Sub
' ******************************************************************************
'过程名：cboDutyData
'说  明：为cboPosition赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboDutyData()
Dim txtDuty As String
Dim resDuty As String
txtDuty = "select DutyId,DutyName from tbDuty"
resDuty = cboData(txtDuty, cboPosition)
End Sub
' ******************************************************************************
'过程名：cboSexData
'说  明：为cboSex赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboSexData()
cboSex.AddItem ("男")
cboSex.AddItem ("女")
End Sub
' ******************************************************************************
'过程名：cboPoliticData
'说  明：为cboSex赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboPoliticData()
cboPolitic.AddItem ("中共党员")
cboPolitic.AddItem ("团员")
cboPolitic.AddItem ("群众")
cboPolitic.AddItem ("民主党派")
End Sub
' ******************************************************************************
'过程名：cboMerryData
'说  明：为cboMerry赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboMerryData()
cboMerry.AddItem ("未婚")
cboMerry.AddItem ("已婚")
cboMerry.AddItem ("离异")
End Sub
' ******************************************************************************
'过程名：cboStateData
'说  明：为cboMerry赋值
'参  数：无
'返回值：无
' ******************************************************************************v
Private Sub cboStateData()
cboState.AddItem ("在职人员")
cboState.AddItem ("兼职人员")
cboState.AddItem ("试用人员")
cboState.AddItem ("离职人员")
cboState.AddItem ("返聘人员")
End Sub
' ******************************************************************************
'过程名：viewDataEmp
'说  明：将信息数据在dg中显示
'参  数：无
'返回值：无
' ******************************************************************************
Private Sub viewDataEmp()
    Dim txtSQLEmp As String
    '检索所有的用户信息
    txtSQLEmp = "select a.EmpId as 职员编号,a.EmpName as 职员姓名,a.Gender as 性别,a.Age as 年龄,"
    txtSQLEmp = txtSQLEmp & "b.NationName as 民族,a.Birthday as 出生日期,a.PoliticalParty as 政治面貌,a.MaritalCon as 婚姻状况,"
    txtSQLEmp = txtSQLEmp & "c.DepName as 所在部门 , a.HireDate as 入职时间, e.EduName as 学历, a.FamilyPlace as 籍贯,"
    txtSQLEmp = txtSQLEmp & "a.IdCard as 身份证号, a.Email as 电子邮箱, a.Officephone as 办公室电话, a.Homephone as 家庭电话,"
    txtSQLEmp = txtSQLEmp & "a.Mobile as 手机,a.State as 职员类型, a.Residence as 住址, a.Postcode as 邮政编码, d.DutyName as 职务,"
    txtSQLEmp = txtSQLEmp & "a.RecorId as 档案号码,a.PRLocation as 户口多在地,a.EmpIdRecord as 信息录入员编号 "
    txtSQLEmp = txtSQLEmp & " from (tbEmployee a left join tbDep c on a.DepId=c.DepId)"
    'txtSQLEmp = txtSQLEmp & "from  tbEmployee a, tbNation b, tbDep c,tbDuty d, tbEdu as e "
    txtSQLEmp = txtSQLEmp & ",tbNation b,tbDuty d, tbEdu as e "
    txtSQLEmp = txtSQLEmp & "where a.NationId=b.NationId and a.DepId=c.DepId and a.DutyId=d.DutyId "
    txtSQLEmp = txtSQLEmp & "and e.EduId=a.EduId"
    results = viewData(txtSQLEmp, dgEmp)
    Me.StatusBar1.Panels(1).Text = "共有" + CStr(results) + "条记录"
    Me.StatusBar1.Panels(1).Alignment = 1
End Sub
' ******************************************************************************
'过程名：getcboDepId
'说  明：获取显示部门名称的cboBox所对应的Id值
'参  数：无
'返回值：无
' ******************************************************************************
Private Sub getcboDepId()
    If cboDep.Text = "" Then
        strDepId = ""
    Else
    strDepId = CStr(cboDep.ItemData(cboDep.ListIndex))
      If Len(strDepId) <> 8 Then
        Select Case Len(strDepId)
            Case 7
                strDepId = "0" + strDepId
            Case 6
                strDepId = "00" + strDepId
            Case 5
                strDepId = "000" + strDepId
            Case 4
                strDepId = "0000" + strDepId
            Case 3
                strDepId = "00000" + strDepId
            Case 2
                strDepId = "000000" + strDepId
            Case 1
                strDepId = "0000000" + strDepId
        End Select
      End If
    End If
End Sub
' ******************************************************************************
'函数名：getcboRetriDepId
'说  明：获取显示检索部分部门名称的cboBox所对应的Id值
'参  数：无
'返回值：无