保存时，检测全称禁止重复和非录入人不能修改

时　间:2013-07-11 09:19:08
作　者:王三平   ID：17  城市：秦皇岛
摘　要:在快速平台生成的客户修改窗体的保存按钮的代码中添加了以下功能：
一是，修改保存，非录入人不能修改。
二是，新增保存，全称禁止重复。
三是，修改保存，全称禁止重复。
现贴出代码，供大家学习参考。

正　文:

Private Sub btnSave_Click()
    On Error GoTo ErrorHandler
    Dim strSQL As String
    Dim cnn As Object           'ADODB.Connection
    Dim rst As Object           'ADODB.Recordset


    If Not CheckRequired(Me) Then
        Exit Sub
    End If


    If Not CheckTextLength(Me) Then
        Exit Sub
    End If
    If GetRoleId() <> 1 Then    '1-系统管理员
        If Not CheckModifer(Me.Name, "录入") Then
            MsgBoxex "你不是录入人,无权保存！", vbCritical
            Exit Sub
        End If
    End If
    strSQL = "Select * FROM [Pur_tblKH] Where [KHId]=" & SQLText(Me![KHID])
    Set rst = OpenADORecordset(strSQL, adLockOptimistic, CurrentProject.Connection)
    If rst.EOF Then
        '新增禁止重复
        If DCount("全称", "Pur_tblKH", "[全称]='" & Me![全称] & "'") > 0 Then
            MsgBoxex "客户全称已经存在，请重新输入", vbCritical
            Me.全称.SetFocus
            Exit Sub
        End If
        rst.AddNew
        Me![KHID] = GetAutoNumber("KHID_Pur_tblKH")
    Else
        If StrComp(Me.全称, mstrKHQC, 0) <> 0 Then
            '修改禁止重复
            If DCount("全称", "Pur_tblKH", "[全称]='" & Me![全称] & "'") > 0 Then
                MsgBoxex "客户全称已经存在，请重新输入", vbCritical
                Me.全称.SetFocus
                Exit Sub
            End If
        End If
    End If
    rst![KHID] = Me![KHID]
    rst![全称] = Me![全称]
    rst![简称] = Me![简称]
    rst![拼音码] = Me![拼音码]
    rst![客户分类] = Me![客户分类]
    rst![地区] = Me![地区]
    rst![城市] = Me![城市]
    rst![公司主页] = Me![公司主页]
    rst![法定代表人] = Me![法定代表人]
    rst![税号] = Me![税号]
    rst![发票地址] = Me![发票地址]
    rst![开户行] = Me![开户行]
    rst![账号] = Me![账号]
    rst![发票电话] = Me![发票电话]
    rst![邮寄地址] = Me![邮寄地址]
    rst![邮编] = Me![邮编]
    rst![联系人] = Me![联系人]
    rst![联系人职务] = Me![联系人职务]
    rst![联系电话] = Me![联系电话]
    rst![联系传真] = Me![联系传真]
    rst![电子邮箱] = Me![电子邮箱]
    rst![汇款开户行1] = Me![汇款开户行1]
    rst![汇款账号1] = Me![汇款账号1]
    rst![汇款开户行2] = Me![汇款开户行2]
    rst![汇款账号2] = Me![汇款账号2]
    rst![备注] = Me![备注]
    rst![是否内部单位] = Me![是否内部单位]
    rst![客户性质] = Me![客户性质]
    rst![行业类别] = Me![行业类别]
    rst![注册资金] = Me![注册资金]
    rst![工商登记编号] = Me![工商登记编号]
    rst![录入] = Me![录入]
    rst.Update
    rst.Close


    MsgBoxex "保存成功！", vbInformation
    If Nz(Me.OpenArgs, "New") = "New" Then
        ClearControlValues Me, "<Clear>"
    Else
        DoCmd.Close acForm, Me.Name, acSaveNo
    End If


ExitHere:
    Set rst = Nothing
    Exit Sub


ErrorHandler:
    MsgBoxex Err.Description, vbCritical
    Resume ExitHere
End Sub


Access快速开发平台QQ群 (群号:321554481) 　　　　　　Access源码网店