K3无界面登录新增职员

最新推荐文章于 2023-03-19 20:33:19 发布

hzvcan

最新推荐文章于 2023-03-19 20:33:19 发布

阅读量2.3k

点赞数

分类专栏：金蝶 vb

本文链接：https://blog.csdn.net/hzvcan/article/details/50674732

版权

金蝶同时被 2 个专栏收录

9 篇文章 0 订阅

订阅专栏

7 篇文章 0 订阅

订阅专栏

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|成功"

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