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
————————————————
版权声明：本文为CSDN博主「hzvcan」的原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接及本声明。
原文链接：https://blog.csdn.net/hzvcan/article/details/50674732