frmnewload.frm

这是一个人事管理系统演示版,用 vb和sql 开发的

         Left            =   360
         TabIndex        =   2
         Top             =   2280
         Width           =   735
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "工号："
         Height          =   255
         Left            =   480
         TabIndex        =   1
         Top             =   600
         Width           =   615
      End
   End
End
Attribute VB_Name = "rrcload"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cancle_Click()
Unload Me
End Sub
Private Sub id_KeyPress(KeyAscii As Integer)
'Private Sub id_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        'Call id_LostFocus
        Call information(Trim(id.text))
        
    End If
End Sub
Private Sub setComboBox(box As ComboBox, text As String)
    Dim i As Integer
    For i = 0 To box.ListCount - 1 Step 1
        If (StrComp(text, Trim(box.List(i))) = 0) Then
            box.ListIndex = i
            Exit Sub
        End If
    Next i
End Sub

Private Sub Form_Load()

Dim rs As ADODB.Recordset
Dim ssql As String
Dim i As Integer
Dim msgtext As String
reset.Enabled = False
ssql = "select * from DEPARTMENT"
Set rs = ExecuteSQL(ssql, msgtext)
For i = 1 To rs.RecordCount
department.AddItem rs.Fields(1)
rs.MoveNext
Next i
rs.Close
ssql = "select * from JOB"
Set rs = ExecuteSQL(ssql, msgtext)
For i = 1 To rs.RecordCount
job.AddItem rs.Fields(1)
rs.MoveNext
Next i
rs.Close
ssql = "select * from EDU_LEVEL"
Set rs = ExecuteSQL(ssql, msgtext)
For i = 1 To rs.RecordCount
education.AddItem rs.Fields(1)
rs.MoveNext
Next i
rs.Close
ssql = "select * from AUTHORITY_LEVEL"
Set rs = ExecuteSQL(ssql, msgtext)
For i = 1 To rs.RecordCount
quthoritylevel.AddItem rs.Fields(1)
rs.MoveNext
Next i
rs.Close
ssql = "select * from STATUS"
Set rs = ExecuteSQL(ssql, msgtext)
For i = 1 To rs.RecordCount
status.AddItem rs.Fields(1)
rs.MoveNext
Next i
rs.Close

If gintMode = 1 Then
        Me.Caption = "员工信息添加"
End If
If gintMode = 2 Then
    Me.Caption = "员工信息修改"
    ssql = "select * from person where NAME='" & RSGLOperator.username & "'"
    Set rs = ExecuteSQL(ssql, msgtext)
    RSGLOperator.authority = rs.Fields(2)
    If (RSGLOperator.authority <> "0") Then
     id.Enabled = False
    End If
    Call information(rs.Fields(0))
End If
End Sub
Private Sub information(id1 As String)
If gintMode = 1 Then '是新添时,不需要显示别的信息
        Exit Sub
    End If
    Dim tmprs As ADODB.Recordset
    
    Dim ssql As String
    ssql = "select * from PERSON where id='" & Trim(id1) & "'"
    Dim msgtext As String
    Set rs = ExecuteSQL(ssql, msgtext)
    id.text = rs.Fields(0)
    password.text = Trim(rs.Fields(1))
     If (Trim(rs.Fields(2)) <> "") Then
        tmpssql = "select DESCRIPTION from AUTHORITY_LEVEL where code ='" _
                    & (Trim(rs.Fields(2))) & "'"
        Set tmprs = ExecuteSQL(tmpssql, msgtext)
        Call setComboBox(quthoritylevel, Trim(tmprs(0)))
        tmprs.Close
    Else
        Call setComboBox(quthoritylevel, "")
    End If
    
    If Not IsNull(Trim(rs.Fields(3))) Then
        names.text = rs.Fields(3)
    End If
    sex.text = rs.Fields(4)
    If Not IsNull(Trim(rs.Fields(5))) Then
        birthdate.text = rs.Fields(5)
    End If
    
    If (Trim(rs.Fields(6)) <> "") Then
        tmpssql = "select name from department where  code='" _
            & (Trim(rs.Fields(6))) & "'"
        Set tmprs = ExecuteSQL(tmpssql, msgtext)
        Call setComboBox(department, Trim(tmprs(0)))
        tmprs.Close
    Else
        Call setComboBox(department, "")
    End If
    
    If (Trim(rs.Fields(7)) <> "") Then
        tmpssql = "select description from job where code ='" _
            & (Trim(rs.Fields(7))) & "'"
        Set tmprs = ExecuteSQL(tmpssql, msgtext)
        Call setComboBox(job, Trim(tmprs(0)))
        tmprs.Close
    Else
        Call setComboBox(job, "")
    End If
    
    If (Trim(rs.Fields(8)) <> "") Then
        tmpssql = "select description from edu_LEVEL where code ='" _
            & (Trim(rs.Fields(8))) & "'"
        Set tmprs = ExecuteSQL(tmpssql, msgtext)
        Call setComboBox(education, Trim(tmprs(0)))
        tmprs.Close
    Else
        Call setComboBox(education, "")
    End If
    
    If Not IsNull(Trim(rs.Fields(9))) Then
        speciality.text = rs.Fields(9)
    End If
    If Not IsNull(Trim(rs.Fields(10))) Then
        address.text = rs.Fields(10)
    End If
    If Not IsNull(Trim(rs.Fields(11))) Then
        tel.text = rs.Fields(11)
    End If
    If Not IsNull(Trim(rs.Fields(12))) Then
        email.text = rs.Fields(12)
    End If
    
    If (Trim(rs.Fields(13)) <> "") Then
        tmpssql = "select description from status where code ='" _
                    & (Trim(rs.Fields(13))) & "'"
        Set tmprs = ExecuteSQL(tmpssql, msgtext)
        Call setComboBox(status, Trim(tmprs(0)))
        tmprs.Close
    Else
        Call setComboBox(status, "")
    End If
    
    If Not IsNull(Trim(rs.Fields(14))) Then
        remark.text = rs.Fields(14)
    End If
    rs.Close



End Sub

Private Sub ok_Click()
Dim ssql As String
Dim rs As New ADODB.Recordset
Dim msgtext As String
If Not IsDate(birthdate.text) Then
MsgBox "生日请按y-m-d的格式输入", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else: birthdate = Format(birthdate, "yyyy-mm-dd")
End If
If Trim(id.text) & "" = "" Then
MsgBox "id不能为空", vbOKOnly + vbExclamation, "警告"
id.SetFocus
Exit Sub
End If
If Trim(password.text) & "" = "" Then
MsgBox "密码不能为空！", vbOKOnly + vbExclamation, "警告"
password.SetFocus
Exit Sub
End If
If Trim(sex.text) & "" = "" Then
MsgBox "性别不能为空！", vbOKOnly + vbExclamation, "警告"
sex.SetFocus
Exit Sub
End If
If tel.text <> "" And Not IsNumeric(tel.text) Then
MsgBox "电话号码只能为数字", vbOKOnly + vbExclamation, "警告"
tel.SetFocus
Exit Sub
End If
If Not IsNumeric(id.text) Then
MsgBox "员工号只能为数字", vbOKOnly + vbExclamation, "警告"
id.SetFocus
Exit Sub
End If
If email.text <> "" And InStr(email.text, "@") = 0 Then
MsgBox "邮箱格式不正确", vbOKOnly + vbExclamation, "警告"
email.SetFocus
Exit Sub
End If
If (gintMode = 1) Then
ssql = "select * from PERSON where ID='" & Trim(id.text) & "'"
Set rs = ExecuteSQL(ssql, msgtext)
If (rs.EOF = False) Then
MsgBox "已经存在此员工编号的信息!", vbOKOnly + vbExclamation, "警告"
id.SetFocus
Exit Sub
End If
rs.Close
End If
ssql = "delete from PERSON where ID='" & Trim(id.text) & "'"
Set rs = ExecuteSQL(ssql, msgtext)
ssql = "select * from PERSON"
Set rs = ExecuteSQL(ssql, msgtext)
rs.AddNew
rs.Fields(0) = Trim(id.text)
rs.Fields(1) = Trim(password.text)
rs.Fields(2) = Trim(quthoritylevel.SelText)
rs.Fields(3) = Trim(names.text)
rs.Fields(4) = Trim(sex.text)
rs.Fields(5) = Trim(birthdate.text)
rs.Fields(6) = Trim(department.SelText)
rs.Fields(7) = Trim(job.SelText)
rs.Fields(8) = Trim(education.SelText)
rs.Fields(9) = Trim(speciality.text)
rs.Fields(10) = Trim(address.text)
rs.Fields(11) = Trim(tel.text)
rs.Fields(12) = Trim(email.text)
rs.Fields(13) = Trim(status.SelText)
rs.Fields(14) = Trim(remark.text)
rs.Update
If gintMode = 1 Then
MsgBox "信息添加成功！", vbOKOnly + vbExclamation, "提示"
rs.Close
Me.Hide
Exit Sub
End If
If gintMode = 2 Then
MsgBox "信息修改成功!", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
gintMode = 0
End Sub

Private Sub reset_Click()
If gintMode = 1 Then
id.text = ""
password.text = ""
quthoritylevel.text = ""
names.text = ""
sex.text = "男"
birthdate.text = ""
department.text = ""
job.SelText = ""
education.text = ""
speciality.text = ""
address.text = ""
tel.text = ""
email.text = ""
status.text = ""
remark.text = ""


End If
End Sub