K3无界面登录新增职员



Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

'编码:钱坤

'日期:20160215

'功能:新增职员

'参数

'1 strAcctNumber:账套编码 eg:02.uitest5

'2 strNumber: 工号,当职员编码

'3 strName: 姓名

'4 strDeptID: 部门ID

'5 strSex: 性别,值(男,女)

'6 strCenterID: 责任中心ID

'7 strOAUser: OAUser 域名

'调用:AddEmp("02.uitest5","11000","张三","4820","男","4782","zhangshan")

'返回:结果标志|结果描述,如果执行成功,则返回内容为"1|成功",如果执行失败,则返回内容为"0|失败原因"

Public Function AddEmp(strAcctNumber As String, strNumber As String, strName As String, strDeptID As String, strSex As String, strCenterID As String, strOAUser As String) As String

Dim m_oLogin As New KDLogin.NoUILogin

Dim oItemClassSet As New EBCGL.ItemClassSet

Dim oItemClass As New EBCGL.ItemClass

Dim oItemSet As New EBCGL.ItemSet

Dim oItem As New EBCGL.Item

Dim m_oSpmMgr As Object

Dim strTemp As String

Dim strSexID As String

Dim BillDataAccess As Object

Dim Rs As ADODB.Recordset

Dim strSQL As String

On Error GoTo err_handle:

'所有参数均不允许为空

'无界面登录

strTemp = m_oLogin.LoginUser("-LoginUser", strAcctNumber, "", "qiankun", "qiankun19860205")

If strTemp <> "" Then

AddEmp = "0|" & strTemp

GoTo A

Exit Function

End If

'以下这段代码如果不加，则oitemset执行报错,在mmts中，该段代码的作用是打开链接

lProc = GetCurrentProcessId()

Set m_oSpmMgr = CreateObject("PropsMgr.ShareProps")

m_oSpmMgr.addproperty lProc, "UserName", m_oLogin.UserName

m_oSpmMgr.addproperty lProc, "PropsString", m_oLogin.PropsString

m_oSpmMgr.addproperty lProc, "LogStatus", m_oLogin.LogStatus

m_oSpmMgr.addproperty lProc, "AcctName", m_oLogin.AcctName

m_oSpmMgr.addproperty lProc, "KDLogin", m_oLogin

'参数检测

If strAcctNumber = "" Or strNumber = "" Or strName = "" Or strDeptID = "" Or strSex = "" Or strCenterID = "" Or strOAUser = "" Then

AddEmp = "0|有参数为空,新增失败"

GoTo A

End If

Set BillDataAccess = CreateObject("BillDataAccess.GetData")

'1.职员是否存在，如果存在，返回错误信息

strSQL = "select 1 from t_emp where fitemid>0 and fnumber='" & strNumber & "' or f_104='" & strOAUser & "'"

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Not Rs.EOF Then

AddEmp = "0|职员编码或者OAUser已存在,新增失败"

GoTo A

End If

'2.部门是否存在

strSQL = "select 1 from t_Department where FNumber like 'N%' and fitemid=" & strDeptID

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

AddEmp = "0|部门不存在,新增失败"

GoTo A

End If

'3.性别是否存在

strSQL = "select * from t_SubMessage where FTypeID =102 and fname='" & strSex & "'"

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

AddEmp = "0|性别不存在，新增失败"

GoTo A

Else

strSexID = Rs.Fields("FInterID")

End If

'4.责任中心检测

strSQL = "select 1 from t_Item where FItemClassID =2040 and fitemid=" & strCenterID

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

AddEmp = "0|责任中心不存在，新增失败"

GoTo A

End If

'开始新增职员

Set oItem = oItemSet.CreateNew(3, 0, strNumber, strName)

Set dic = GetNameFieldMap(oItemClassSet(3))

oItem.Properties(dic("部门名称")) = strDeptID

oItem.Properties(dic("性别")) = strSexID 'select * from t_SubMessage where FTypeID =102

oItem.Properties(dic("责任中心")) = strCenterID 'select * from t_Item where FItemClassID =2040

oItem.Properties(dic("OAUser")) = strOAUser

oItem.SaveChanges

AddEmp = "1|成功"

A:

'关闭连接，释放资源

m_oSpmMgr.DelProperty lProc, "UserName", ""

m_oSpmMgr.DelProperty lProc, "PropsString", ""

m_oSpmMgr.DelProperty lProc, "LogStatus", ""

m_oSpmMgr.DelProperty lProc, "AcctName", ""

m_oSpmMgr.DelProperty lProc, "KDLogin", Null

Set m_oSpmMgr = Nothing

Set BillDataAccess = Nothing

Set Rs = Nothing

Set m_oLogin = Nothing

Set oItemClassSet = Nothing

Set oItemClass = Nothing

Set oItemSet = Nothing

Set oItem = Nothing

Exit Function

err_handle:

AddEmp = "0|" & Err.Description

End Function

'编码:钱坤

'日期:20160216

'功能:修改职员

'参数

'1 strAcctNumber:账套编码 eg:02.uitest5

'2 strNumber: 工号,当职员编码

'3 strName: 姓名

'4 strDeptID: 部门ID

'5 strSex: 性别,值(男,女)

'6 strCenterID: 责任中心ID

'7 strOAUser: OAUser 域名

'调用:UpdateEmp("02.uitest5","11000","张三","4820","男","4782","zhangshan")

'返回:结果标志|结果描述,如果执行成功,则返回内容为"1|成功",如果执行失败,则返回内容为"0|失败原因"

Public Function UpdateEmp(strAcctNumber As String, strNumber As String, strName As String, strDeptID As String, strSex As String, strCenterID As String, strOAUser As String) As String

Dim m_oLogin As New KDLogin.NoUILogin

Dim oItemClassSet As New EBCGL.ItemClassSet

Dim oItemClass As New EBCGL.ItemClass

Dim oItemSet As New EBCGL.ItemSet

Dim oItem As New EBCGL.Item

Dim m_oSpmMgr As Object

Dim strTemp As String

Dim strSexID As String

Dim strK3Number As String

Dim BillDataAccess As Object

Dim Rs As ADODB.Recordset

Dim strSQL As String

On Error GoTo err_handle:

'无界面登录

strTemp = m_oLogin.LoginUser("-LoginUser", strAcctNumber, "", "qiankun", "qiankun19860205")

If strTemp <> "" Then

UpdateEmp = "0|" & strTemp

GoTo A

Exit Function

End If

'以下这段代码如果不加，则oitemset执行报错,在mmts中，该段代码的作用是打开链接

lProc = GetCurrentProcessId()

Set m_oSpmMgr = CreateObject("PropsMgr.ShareProps")

m_oSpmMgr.addproperty lProc, "UserName", m_oLogin.UserName

m_oSpmMgr.addproperty lProc, "PropsString", m_oLogin.PropsString

m_oSpmMgr.addproperty lProc, "LogStatus", m_oLogin.LogStatus

m_oSpmMgr.addproperty lProc, "AcctName", m_oLogin.AcctName

m_oSpmMgr.addproperty lProc, "KDLogin", m_oLogin

'参数检测

'所有参数均不允许为空

If strAcctNumber = "" Or strNumber = "" Or strName = "" Or strDeptID = "" Or strSex = "" Or strCenterID = "" Or strOAUser = "" Then

UpdateEmp = "0|有参数为空,修改失败"

GoTo A

End If

Set BillDataAccess = CreateObject("BillDataAccess.GetData")

'1.职员是否存在，如果存在，返回错误信息,修改时，以域用户为准

strSQL = "select fnumber from t_emp where fitemid>0 and f_104='" & strOAUser & "'"

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

UpdateEmp = "0|OAUser(域用户)不存在,修改失败"

GoTo A

Else

strK3Number = Rs.Fields("fnumber")

End If

'2.部门是否存在

strSQL = "select 1 from t_Department where FNumber like 'N%' and fitemid=" & strDeptID

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

UpdateEmp = "0|部门不存在,修改失败"

GoTo A

End If

'3.性别是否存在

strSQL = "select * from t_SubMessage where FTypeID =102 and fname='" & strSex & "'"

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

UpdateEmp = "0|性别不存在，修改失败"

GoTo A

Else

strSexID = Rs.Fields("FInterID")

End If

'4.责任中心检测

strSQL = "select 1 from t_Item where FItemClassID =2040 and fitemid=" & strCenterID

Set Rs = BillDataAccess.ExecuteSQL(m_oLogin.PropsString, strSQL)

If Rs.EOF Then

UpdateEmp = "0|责任中心不存在，修改失败"

GoTo A

End If

'开始修改职员

Set oItem = oItemSet.Item(, 3, strK3Number)

Set dic = GetNameFieldMap(oItemClassSet(3))

oItem.Properties("fnumber") = strK3Number

oItem.Properties("fname") = strName

oItem.Properties(dic("部门名称")) = strDeptID

oItem.Properties(dic("性别")) = strSexID 'select * from t_SubMessage where FTypeID =102

oItem.Properties(dic("责任中心")) = strCenterID 'select * from t_Item where FItemClassID =2040

oItem.Properties(dic("OAUser")) = strOAUser

oItem.SaveChanges

UpdateEmp = "1|成功"

A:

'关闭连接，释放资源

m_oSpmMgr.DelProperty lProc, "UserName", ""

m_oSpmMgr.DelProperty lProc, "PropsString", ""

m_oSpmMgr.DelProperty lProc, "LogStatus", ""

m_oSpmMgr.DelProperty lProc, "AcctName", ""

m_oSpmMgr.DelProperty lProc, "KDLogin", Null

Set m_oSpmMgr = Nothing

Set BillDataAccess = Nothing

Set Rs = Nothing

Set m_oLogin = Nothing

Set oItemClassSet = Nothing

Set oItemClass = Nothing

Set oItemSet = Nothing

Set oItem = Nothing

Exit Function

err_handle:

UpdateEmp = "0|" & Err.Description

End Function

Public Function GetNameFieldMap(ByVal oItemClass As EBCGL.ItemClass) As KFO.Dictionary

'功能:根据传入的核算项目,返回属性名称和对应的字段名,如 电话-fphone

On Error GoTo err_handle

Dim dic As New KFO.Dictionary

Dim i As Long

For i = 1 To oItemClass.CustomProperties.Count

dic(oItemClass.CustomProperties.Item(i).Name) = oItemClass.CustomProperties.Item(i).SQLColumnName

Next i

Set GetNameFieldMap = dic

Exit Function

err_handle:

MsgBox Err.Description

End Function