| |
| ClearQuest+Excel用户管理与数据管理HOOK代码示例
|
| |
| |
| |
通过Excel下创建VBScript宏代码的方式对CQ下的用户进行管理，并配置用户归属组，对老系统与新系统之间数据到导入导出。
HOOK源代码如下:
----------------------------------------------------------------------
Private Sub CommandButton1_Click()
'开始导出Group数据
On Error Resume Next
Dim loginName,
pwd, userName, email, mobile, desc, groups, wsDataUser,
wsDataGroup, wsDataACL
prom = MsgBox("请您确认要开始导出CQ库的Group数据吗？", vbOKCancel)
If prom = vbCancel Then
Exit Sub
End If
Dim res_login_name, res_login_pwd,
res_so, res_master
Dim dest_login_name,
dest_login_pwd, dest_so, dest_master
Set ws = Worksheets("CQConfiguration")
Set wsDataGroup = Worksheets("Groups")
res_login_name = ws.Cells(4, 2).Value
res_login_pwd = ws.Cells(5, 2).Value
res_master = ws.Cells(3, 2).Value
Set res_so = CreateObject("ClearQuest.AdminSession")
If res_login_name
= "" Or res_login_pwd = "" Then
MsgBox ("源CQ库的用户登录名/用户登录密码必须填写完整！")
Exit Sub
End If
res_so.Logon
res_login_name, res_login_pwd, res_master
If Err.Number > 0 Then
MsgBox ("源CQ库登录失败，请确认连接配置参数！")
Err.Clear
Exit Sub
Else
MsgBox ("源CQ库登录成功！")
End If
Set groupList = res_so.groups
iIndex = 0
For
Each g In groupList
iIndex = iIndex + 1
wsDataGroup.Cells(iIndex, 1).Value = g.Name
ws.Cells(23, 4).Value = "正在导出Group数据，已经导出记录数："
& iIndex
DoEvents
Next
Set res_so = Nothing
MsgBox ("从源CQ库中导出Group数据结束！")
ws.Cells(23, 4).Value = ""
End Sub
Private Sub CommandButton2_Click()
'开始导出User数据
On Error Resume Next
Dim loginName,
pwd, userName, email, mobile, desc, groups, wsDataUser,
wsDataGroup, wsDataACL
prom = MsgBox("请您确认要开始导出CQ库的User数据吗？",
vbOKCancel)
If prom = vbCancel
Then
Exit
Sub
End If
Dim res_login_name, res_login_pwd,
res_so, res_master
Dim dest_login_name,
dest_login_pwd, dest_so, dest_master
Set ws = Worksheets("CQConfiguration")
Set wsDataUser = Worksheets("Users")
res_login_name = ws.Cells(4, 2).Value
res_login_pwd = ws.Cells(5, 2).Value
res_master = ws.Cells(3, 2).Value
Set res_so = CreateObject("ClearQuest.AdminSession")
If res_login_name
= "" Or res_login_pwd = "" Then
MsgBox ("源CQ库的用户登录名/用户登录密码必须填写完整！")
Exit Sub
End If
res_so.Logon
res_login_name, res_login_pwd, res_master
If Err.Number > 0 Then
MsgBox ("源CQ库登录失败，请确认连接配置参数！")
Err.Clear
Exit Sub
Else
MsgBox ("源CQ库登录成功！")
End If
Set userlist = res_so.Users
Dim iIndex, groupNameList, miscInfoValue
iIndex = 0
groupNameList
= ""
For Each userObj
In userlist
If Not userObj.Active Then
'''
Else
Set groupColl = userObj.groups
For Each g In groupColl
groupNameList = groupNameList & "," &
g.Name
Next
iIndex = iIndex + 1
wsDataUser.Cells(iIndex, 1).Value = userObj.Name
wsDataUser.Cells(iIndex, 2).Value = userObj.FullName
wsDataUser.Cells(iIndex, 3).Value = userObj.email
wsDataUser.Cells(iIndex, 4).Value = userObj.phone
wsDataUser.Cells(iIndex, 5).Value = groupNameList
wsDataUser.Cells(iIndex, 6).Value = userObj.miscinfo
DoEvents
Set userObj = Nothing
Set groupColl = Nothing
groupNameList = ""
ws.Cells(23, 4).Value = "正在导出User数据，已经导出记录数："
& iIndex
End If
Next
Set res_so = Nothing
MsgBox ("从源CQ库中导出User数据结束！")
ws.Cells(23, 4).Value = ""
End Sub
Private Sub CommandButton3_Click()
'开始导出ACL数据
On Error Resume Next
Dim wsDataACL
Set ws = Worksheets("CQConfiguration")
Set wsDataACL = Worksheets("ACLs")
res_prd_master_dbname = ws.Cells(19,
2).Value
res_prd_user_dbname =
ws.Cells(20, 2).Value
res_prd_login_name
= ws.Cells(21, 2).Value
res_prd_login_pwd
= ws.Cells(22, 2).Value
Set so = CreateObject("ClearQuest.Session")
so.UserLogon res_prd_login_name, res_prd_login_pwd,
res_prd_user_dbname, AD_PRIVATE_SESSION, res_prd_master_dbname
If Err.Number > 0 Then
Err.Clear
MsgBox ("登录失败！")
Exit Sub
Else
MsgBox ("登录源CQ用户数据成功！")
End If
Set querydef = so.BuildQuery("ACL")
querydef.BuildField ("name")
querydef.BuildField ("Description")
querydef.BuildField ("Note_Entry")
querydef.BuildField ("ratl_context_groups")
Set rs = so.BuildResultSet(querydef)
rs.EnableRecordCount
rs.Execute
f = rs.MoveNext
iIndex = 0
Do While f = 1
DoEvents
iIndex = iIndex + 1
wsDataACL.Cells(iIndex, 1).Value = rs.GetColumnValue(1)
wsDataACL.Cells(iIndex,
2).Value = rs.GetColumnValue(2)
wsDataACL.Cells(iIndex, 3).Value = rs.GetColumnValue(3)
wsDataACL.Cells(iIndex,
4).Value = rs.GetColumnValue(4)
ws.Cells(23, 4).Value = "正在导出ACL数据，已经导出记录数："
& iIndex
f = rs.MoveNext
Loop
Set querydef = Nothing
Set so = Nothing
MsgBox ("从源CQ库中导出ACL数据结束！")
ws.Cells(23, 4).Value = ""
End Sub
Private Sub CommandButton4_Click()
On Error Resume Next
'将Group数据导入到目的CQ库
'计算数据行数
Dim
ws, rowCounts, rowIndex, curCell
Set wsDataGroup = Worksheets("Groups")
Set ws = Worksheets("CQConfiguration")
rowCounts =
1
rowIndex = 1
Set curCell = wsDataGroup.Cells(rowIndex, 1)
'计算总行数
Do While Not IsEmpty(curCell)
rowIndex = rowIndex + 1
Set curCell = wsDataGroup.Cells(rowIndex, 1)
Loop
rowCounts = rowIndex - 1
dest_master = ws.Cells(11, 2).Value
dest_login_name = ws.Cells(12, 2).Value
dest_login_pwd = ws.Cells(13, 2).Value
Set dest_so = CreateObject("ClearQuest.AdminSession")
dest_so.Logon dest_login_name, dest_login_pwd,
dest_master
If Err.Number >
0 Then
MsgBox ("目的CQ库登录失败，请确认连接配置参数！")
Err.Clear
Set dest_so = Nothing
Exit Sub
Else
MsgBox ("目的CQ库登录成功！")
End If
Dim ret
Set dl = dest_so.Databases
For
i = 1 To rowCounts
gn = wsDataGroup.Cells(i, 1)
If Not isExistGroup(dest_so, gn) Then
ret = addGroup(dest_so, gn)
End If
For Each d In dl
ret.SubscribeDatabase d.Name
Next
ws.Cells(23,
4).Value = "正在导入Group数据，已经导入记录数：" & i
DoEvents
Next
For Each d In dl
d.UpgradeMasterUserInfo
Next
Set ret = Nothing
Set dest_so = Nothing
MsgBox ("导入/更新Group数据到目的CQ库结束！")
ws.Cells(23, 4).Value = ""
End Sub
Function isExistGroup(so, gn)
'判断目的master库中是否已经存在该group
isExistGroup = False
Set gs = so.groups
For Each g In
gs
gn1
= g.Name
If gn1 = gn Then
isExistGroup = True
Exit For
End If
Next
End Function
Function addGroup(so, gn)
'创建一个新的Group
Set newGroup = so.CreateGroup(gn)
addGroup = newGroup
End Function
Private Sub CommandButton5_Click()
'On Error Resume Next
'将User数据导入到目的CQ库
'计算数据行数
Dim
wsDataUser, rowCounts, rowIndex, curCell, ws
Set wsDataUser = Worksheets("Users")
Set ws = Worksheets("CQConfiguration")
rowCounts = 1
rowIndex = 1
Set curCell = wsDataUser.Cells(rowIndex,
1)
'计算总行数
Do While Not IsEmpty(curCell)
rowIndex = rowIndex + 1
Set curCell = wsDataUser.Cells(rowIndex, 1)
Loop
rowCounts = rowIndex - 1
dest_master = ws.Cells(11, 2).Value
dest_login_name = ws.Cells(12, 2).Value
dest_login_pwd = ws.Cells(13, 2).Value
Set dest_so = CreateObject("ClearQuest.AdminSession")
dest_so.Logon dest_login_name, dest_login_pwd,
dest_master
If Err.Number >
0 Then
MsgBox ("目的CQ库登录失败，请确认连接配置参数！")
Err.Clear
Set dest_so = Nothing
Exit Sub
Else
MsgBox ("目的CQ库登录成功！")
End If
Dim ret, newUser
For i = 1 To rowCounts
loginName = wsDataUser.Cells(i, 1)
userName = wsDataUser.Cells(i, 2)
email = wsDataUser.Cells(i, 3)
phone = wsDataUser.Cells(i, 4)
groupl = wsDataUser.Cells(i, 5)
miscinfo = wsDataUser.Cells(i, 6)
If Not isExistUser(dest_so, loginName) Then
Set newUser = dest_so.CreateUser(loginName)
Else
Set newUser = dest_so.GetUser(loginName)
End If
newUser.FullName userName
newUser.email email
newUser.phone phone
newUser.miscinfo miscinfo
'先将该用户所有的组设置清空
Set group_coll
= newUser.groups
For Each ggg In group_coll
nnn = ggg.Name
If nnn <> "Everyone" Then
ggg.RemoveUser newUser
End If
Next
newUser.UpgradeInfo
'再重新按照excel中的内容设置用户的组
groupArray
= Split(groupl, ",")
For Each g In groupArray
If g <> "" And g <> "Everyone"
Then
Set go = dest_so.GetGroup(g)
go.AddUser newUser
End If
Next
newUser.UpgradeInfo
ws.Cells(23,
4).Value = "正在导入User数据，已经导入记录数：" & i
DoEvents
Next
Set dl = dest_so.Databases
For
Each d In dl
If d.Name <> "MASTR" Then
d.UpgradeMasterUserInfo
End If
Next
Set dest_so = Nothing
MsgBox ("导入/更新User数据到目的CQ库结束！")
ws.Cells(23, 4).Value = ""
End Sub
Function isExistUser(so, un)
'判断目的master库中是否已经存在该user
isExistUser = False
Set ul = so.Users
For Each u In
ul
un1
= u.Name
If un1 = un Then
isExistUser = True
Exit For
End If
Next
End Function
Private Sub CommandButton6_Click()
On Error Resume Next
'将ACL数据导入到目的CQ库
'计算数据行数
Dim
ws, wsDataACL, rowCounts, rowIndex, curCell
Set ws = Worksheets("CQConfiguration")
Set wsDataACL = Worksheets("ACLs")
rowCounts = 1
rowIndex = 1
Set curCell = wsDataACL.Cells(rowIndex,
1)
'计算总行数
Do While Not IsEmpty(curCell)
rowIndex = rowIndex + 1
Set curCell = wsDataACL.Cells(rowIndex, 1)
Loop
rowCounts = rowIndex - 1
dest_prd_master_dbname = ws.Cells(28,
2).Value
dest_prd_user_dbname =
ws.Cells(29, 2).Value
dest_prd_login_name
= ws.Cells(30, 2).Value
dest_prd_login_pwd
= ws.Cells(31, 2).Value
Set so = CreateObject("ClearQuest.Session")
so.UserLogon dest_prd_login_name, dest_prd_login_pwd,
dest_prd_user_dbname, AD_PRIVATE_SESSION, dest_prd_master_dbname
If Err.Number > 0 Then
Err.Clear
MsgBox ("登录失败！")
Exit Sub
Else
MsgBox ("登录目的CQ用户数据成功！")
End If
For i = 1 To rowCounts
uname = wsDataACL.Cells(i, 1)
desc = wsDataACL.Cells(i, 2)
miscinfo = wsDataACL.Cells(i, 3)
groupl = wsDataACL.Cells(i, 4)
Set acl = so.GetEntity("ACL", uname)
If Err.Number > 0 Then
Set acl = so.BuildEntity("ACL")
acl.SetFieldValue "name", uname
'acl.SetFieldValue "Note_Entry", miscinfo
acl.SetFieldValue "Description", desc
acl.AddFieldValue "ratl_context_groups", groupl
ret = acl.Validate
If ret = "" Then
acl.Commit
Else
MsgBox ret
End If
Else
Set acl = so.GetEntity("ACL", uname)
so.EditEntity acl, "Modify"
'acl.SetFieldValue "Note_Entry", miscinfo
acl.SetFieldValue "Description", desc
acl.AddFieldValue "ratl_context_groups", groupl
ret = acl.Validate
If ret = "" Then
acl.Commit
Else
MsgBox ret
End If
End If
Err.Clear
ws.Cells(23, 4).Value = "正在导入ACL数据，已经导入记录数："
& i
DoEvents
Next
Set acl = Nothing
Set so = Nothing
MsgBox ("导入/更新ACL数据到目的CQ库结束！")
ws.Cells(23, 4).Value = ""
End Sub
----------------------------------------------------------------------
详细可从附件中参考。
 |
| 文件: |
CQ_Groups_Users_Export_Import_sample.rar |
| 大小: |
31KB |
| 下载: |
下载 |
|
|
|
|
