VB开发的ERP系统

        EmpID = 0
        SwitchToolBar (0)
        Call SetTxtStatus(True, True, False, Lrzt)
    Else                                                                        '窗体是经过查询结果调用生成的
        If Lrzt = 1 Then                                                        '从增加状态返回
            SwitchToolBar (0)
            EmpID = lID.Caption
            LoadData (EmpID)
            Call SetTxtStatus(False, True, False, Lrzt)
        End If
        If Lrzt = 2 Then                                                        '从修改状态返回
            SwitchToolBar (0)
            Call SetTxtStatus(False, True, False, Lrzt)
        End If
    End If
    Lrzt = 0
MF_Cancel = True
errD:
End Function

Private Function MF_Save() As Boolean
'供工具条按钮调用的函数（保存记录），成功返回真，否则假
MF_Save = False
On Error GoTo errD
    If Lrzt = 2 And EmpID = 0 Then Exit Function                                     '修改并且还没有选人的时候
    If DataIsEffect(0) Then Call Save
    If Saved Then
        Call Xtxxts("保存成功!", 0, 4)
        SwitchToolBar (0)
        lpId.Caption = lID.Caption
        lID.Caption = EmpID
        Call SetTxtStatus(False, True, False, Lrzt)
        Lrzt = 0
'         如果是查询模式，要刷新记录集a
        If FormOwner = "Query" Then
            If QuerySet.State = 1 Then QuerySet.Close
            Set QuerySet = Cw_DataEnvi.DataConnect.Execute(QuerySql)
            QuerySet.Find "Rs_BasicInfo#EmpID  = " & EmpID
            Qr_RsBasicFrm.BeenModify = True
        End If
        Saved = False
        MF_Save = True
    Else
        Call Xtxxts("保存失败!", 0, 1)
    End If
errD:
End Function



Private Function CorHlpIsEffect(sItmID As String, StrText As String) As Boolean
'校验相关项填写的正确性
'参数说明:sItmID是项目编号，StrText是要校验的内容，可以是编码或是对应条目

Dim RsRec As New Recordset
Dim sSql As String
Dim RsItm As New Recordset
    
    CorHlpIsEffect = False
    '选取文本框对应的人事项目，得到相关项的信息
    Set RsItm = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Rs_Items WHERE itemId=" & sItmID)
    If Not IsNumeric(Trim(StrText)) Then                                                 '对数字型的相关明细代号                                               '相关项当对应文本框输入编码的情况
        If Trim(RsItm!CorTable) = "Rs_CorSub" Then                                       '首先根据项目名进行查询
            sSql = "SELECT * FROM Rs_CorMain m,Rs_CorSub s WHERE " _
                   & "m.SortId=s.SortId AND m.SortId='" & Trim(RsItm!Correlation) & "' AND listname='" & Trim(StrText) & "'"
        Else
            If UCase(Trim(RsItm!CorTable)) <> "GY_DEPARTMENT" Then
                sSql = "SELECT * FROM " & RsItm!CorTable & " WHERE " & RsItm!IndexName & "='" & Trim(StrText) & "'"
            Else
                sSql = "SELECT * FROM " & RsItm!CorTable & " WHERE " & RsItm!IndexName & " like '" & Trim(StrText) & "'"
            End If
        End If
    Else                                                                                 '相关项当文本框输入编码对应文本的情况
        If Trim(RsItm!CorTable) = "Rs_CorSub" Then
            sSql = "SELECT * FROM Rs_CorMain m,Rs_CorSub s WHERE " _
               & "m.SortId=s.SortId AND m.SortId='" & Trim(RsItm!Correlation) & "' AND convert(int,(right(convert(varchar(12),listid),3)))='" & Trim(StrText) & "'"
        Else
            If UCase(Trim(RsItm!CorTable)) <> "GY_DEPARTMENT" Then
                sSql = "SELECT * FROM " & Trim(RsItm!CorTable) & " WHERE " & RsItm!IndexCode & "='" & Trim(StrText) & "'"
            Else
                sSql = "SELECT * FROM " & Trim(RsItm!CorTable) & " WHERE " & RsItm!IndexCode & " like '" & Trim(StrText) & "%'"
            End If
        End If
    End If
        
    Set RsRec = Cw_DataEnvi.DataConnect.Execute(sSql)
    If UCase(Trim(RsItm!CorTable)) = "GY_DEPARTMENT" Then                                     '部门组织的相关帮助必须录入末级节点，所以 >1是不可以的
        If RsRec.RecordCount = 1 Then CorHlpIsEffect = True
    Else
        If RsRec.RecordCount > 0 Then CorHlpIsEffect = True
    End If
    If CorHlpIsEffect Then                                                               '找到相关项时
        If Trim(RsItm!CorTable) = "Rs_CorSub" Then                                       '标准情况：相关项存在Rs_CorSub里
            P_Name = RsRec!ListName
            P_Code = RsRec!ListID
        Else                                                                             '相关项存在其他表里
            P_Name = Trim(RsRec(Trim(RsItm!IndexName)))
            P_Code = RsRec(Trim(RsItm!IndexCode))
        End If
    End If
    
    If RsItm.State = 1 Then
        RsItm.Close
        Set RsItm = Nothing
    End If
    '关闭记录集，退出
    RsRec.Close
Exit Function

End Function

Private Function DataIsEffect(Index As Integer) As Boolean
'有效性判定,控制较松，除工号，姓名，部门以外其他都可以不录
'index 表示需要做有效性校验的对象序号，如果index=0 则表示对所有的文本框做有效性校验
    Dim i As Integer
    Dim Tsxx As String
    DataIsEffect = False
    
'文本框有效性判定
If Index = 0 Then                                                              '对所有文本框进行校验
    For i = 1 To Lbl_ItmName.UBound
        If UCase(tFieldName(i)) = "EMPNO" And (Trim(Txt_RsItm(i).Text) = "") Then
            Call Xtxxts("职工号不能为空!", 0, 1)
            If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
            Exit Function
        End If
                
        If Lrzt = 1 Then
            If UCase(tFieldName(i)) = "EMPNO" And GetIdByNo(Trim(Txt_RsItm(i).Text)) <> 0 Then
                Call Xtxxts("职工号重复!", 0, 1): Exit Function
            End If
        End If
        
        If UCase(tFieldName(i)) = "EMPNAME" And (Trim(Txt_RsItm(i).Text) = "") Then
            Call Xtxxts("职工姓名不能为空!", 0, 1)
            If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
            Exit Function
        End If
                
        If UCase(tFieldName(i)) = "DEPTCODE" And Trim(Txt_RsItm(i).Text) = "" Then
            Call Xtxxts("部门不能为空!", 0, 1)
            If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
            Exit Function
        End If
        
        If tDataType(i) = 7 And Trim(Txt_RsItm(i).Text) <> "" Then
            If IsDate(Txt_RsItm(i)) = False Then
                Call Xtxxts("非法日期格式! ——" & Format(Date, "yyyy-mm-dd"), 0, 1)
                If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
                Exit Function
            End If
        End If
        
        If tDataType(i) = 5 And Trim(Txt_RsItm(i).Text) <> "" Then
            If IsNumeric(Txt_RsItm(i)) = False Then
                Call Xtxxts("录入数据不是数字!", 0, 1)
                If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
                Exit Function
            End If
        End If
        
        If tIsCode(1, i) = 1 Then                                                '对编码型的数据只要不为空，就要检测有效性
            If tDataType(i) <> 7 Then
                If Trim(Txt_RsItm(i).Text) <> "" Then
                    If CorHlpIsEffect(Str(tItmId(i)), Trim(Txt_RsItm(i).Text)) = True Then
                        Txt_RsItm(i).Text = Trim(P_Name)
                        tIsCode(2, i) = Trim(P_Code)
                    Else
                        Call Xtxxts("非法录入,没有此" & Lbl_ItmName(Index).Caption, 0, 1)
                        If Txt_RsItm(i).Enabled Then Txt_RsItm(i).SetFocus
                        Exit Function
                    End If
                Else
                    tIsCode(2, i) = ""
                End If
            End If
        End If
     Next i
     
Else                                                                                '只对txt_RsItm(index)校验
    If Cmd_CommHlp(Index).Tag = 1 Then                                              ' 备注： 除此以外 还要针对职工号检查
        If tDataType(Index) = 7 And Trim(Txt_RsItm(Index).Text) <> "" Then
            If IsDate(Txt_RsItm(Index)) = False Then
                Call Xtxxts("非法日期格式! ——" & Format(Date, "yyyy-mm-dd"), 0, 1)
                If Txt_RsItm(Index).Enabled Then Txt_RsItm(Index).SetFocus
                Exit Function
            End If
        End If
        If tIsCode(1, Index) = 1 Then                                                '对编码型的数据只要不为空，就要检测有效性
            If tDataType(Index) <> 7 Then
                If Trim(Txt_RsItm(Index).Text) <> "" Then
                    If CorHlpIsEffect(Str(tItmId(Index)), Trim(Txt_RsItm(Index).Text)) = True Then
                        Txt_RsItm(Index).Text = Trim(P_Name)
                        tIsCode(2, Index) = Trim(P_Code)
                    Else
                        Tsxx = "非法录入,没有此" & Lbl_ItmName(Index).Caption
                        If UCase(Trim(tFieldName(Index))) = "DEPTCODE" Then Tsxx = Tsxx + "或者录入的不是末级节点!"
                        Call Xtxxts(Tsxx, 0, 1)
                        If Txt_RsItm(Index).Enabled Then Txt_RsItm(Index).Text = "": Txt_RsItm(Index).SetFocus
                        Exit Function
                    End If
                Else
                    tIsCode(2, i) = ""
                End If
            End If
        End If
    End If

    End If
    DataIsEffect = True
    
End Function

Private Function SetReserve() As Boolean
Dim tmpRs As New ADODB.Recordset
Dim i As Integer
    Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Rs_Items WHERE (SID='1' AND YNShow='1') ORDER BY Tab")
    ReDim Preserve tReserved(tmpRs.RecordCount)
    i = 1
    While Not tmpRs.EOF
        If IsNull(tmpRs.Fields("YNReserve")) Or tmpRs.Fields("YNReserve") = False Then tReserved(i) = False
        If tmpRs.Fields("YNReserve") = True Then tReserved(i) = True
        tmpRs.MoveNext
        i = i + 1
    Wend
End Function


Private Function DelArRec(emp_id As Integer) As Boolean
'删除人事档案基本信息，如果删除成功返回真，否则返回假

Dim yn As String
    DelArRec = False
    If EmpID = 0 Then Exit Function
    yn = Xtxxts("真的要删除此档案？ ", 2, 2)
    If yn = vbCancel Then Exit Function

    On Error GoTo Err_Del
        Cw_DataEnvi.DataConnect.BeginTrans
        '自定义
            Cw_DataEnvi.DataConnect.Execute "DELETE Rs_ExtendInfo WHERE EmpID=" & EmpID
            Cw_DataEnvi.DataConnect.Execute "DELETE Rs_BasicInfo WHERE EmpID=" & EmpID
        
        Cw_DataEnvi.DataConnect.CommitTrans
    EmpID = 0
    DelArRec = True
    Exit Function

Err_Del:
    Cw_DataEnvi.DataConnect.CommitTrans
    If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
        Call Xtxxts("该人员档案已经被使用,不能删除!", 0, 1)
        Exit Function
    Else
        Call Xtxxts("出现未知情况,该人员档案不能被删除!", 0, 1)
        Exit Function
    End If
End Function


Private Sub Save()              '保存数据
Dim i As Integer
Dim EmpNo As String             '职工号
Dim Ssql1 As String             '对应非固定项（Rs_ExtendInfo中的字段）的名称（FieldName）
Dim Ssql2 As String             '对应非固定项（Rs_ExtendInfo中的字段）的值
Dim Ssql3 As String             '对应固定项（Rs_BasicInfo中的字段）的名称（FieldName）
Dim Ssql4 As String             '对应固定项（Rs_BasicInfo中的字段）的值
Dim SsqlR As String             '专门针对保留项目的查询语句
Dim tmpRs As New Recordset: Dim MAXID_Z As Integer

Saved = False

If Lbl_ItmName.Count < 2 Then Call Xtxxts("没有项目!", 0, 1): Exit Sub

EmpNo = Trim(Txt_RsItm(1).Text)                                                       '工号
For i = 1 To Lbl_ItmName.UBound
    If tFixed(i) = True Then                                                             '首先整理固定字段 Rs_BasicInfo,将字段名和值的sql语句拼好
        If Lrzt = 1 Then                                                              '增加
            Ssql3 = Ssql3 & tFieldName(i) & ","
            If tIsCode(1, i) = 1 Then                                                 '是编码型的就存编码，否则存名称，这里的数组的初值是根据有无相关项决定的
                Ssql4 = Ssql4 & "'" & tIsCode(2, i) & "',"
            Else
                Select Case tDataType(i)
                    Case 7
                        If Trim(Txt_RsItm(i).Text) = "" Then
                           '没填的日期型字段存NULL
                            Ssql4 = Ssql4 & "null,"
                        Else
                            Ssql4 = Ssql4 & "'" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
                        End If
                    Case 5
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的数字型字段存0
                            Ssql4 = Ssql4 & "0,"
                        Else
                            Ssql4 = Ssql4 & Trim(Txt_RsItm(i).Text) & ","
                        End If
                    Case Else
                        If UCase(tFieldName(i)) = "YNSTOP" Then
                            Ssql4 = Ssql4 & "'" & Chk_YNStop.Value & "',"
                        Else
                            Ssql4 = Ssql4 & "'" & Trim(Txt_RsItm(i).Text) & "',"
                        End If
                    End Select
            End If
        Else                                                    '修改
            If tIsCode(1, i) = 1 Then
                Ssql3 = Ssql3 & tFieldName(i) & "='" & tIsCode(2, i) & "',"
            Else
                Select Case tDataType(i)
                    Case 7
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的日期型字段存NULL
                            Ssql3 = Ssql3 & tFieldName(i) & "= null,"
                        Else
                            Ssql3 = Ssql3 & tFieldName(i) & "='" & Format(Trim(Txt_RsItm(i).Text), "yyyy-mm-dd") & "',"
                        End If
                    Case 5
                        If Trim(Txt_RsItm(i).Text) = "" Then
                            '没填的数字型字段存0
                            Ssql3 = Ssql3 & tFieldName(i) & "= 0,"
                        Else