How do I copy a Project List from one project to another or import the list for values from Excel?
Question ID: 106707
0
0

How do I copy a "Project List" from one project to another or import the list for values from Excel?

Marked as spam
Posted by (Questions: 1, Answers: 1)
Asked on February 23, 2016 7:18 pm
21 views
Answers (2)
0
Private answer

@DavidRCCL ,

Here is an old example I found for doing this in Excel. You may need to make some slight adjustments, but it should be pretty close to what you need:

Dim qcServer, qcDomain, qcProject, qcUser, qcPassword, ListItemFound, cCount, rCount, listexists,
colconv, listname, cntLcustnu1, listitem, append

'Define variable values for QC connection
qcServer = ''http://YOUR_SERVER:8080/qcbin''
qcDomain = ''DEFAULT''
qcProject = ''ALM_DEMO''
qcUser = ''alex_alm''
qcPassword = ''''

'Create the TD Connection object
Set tdc = CreateObject(''tdapiole80.tdconnection'')

'Establish the connection and log in to the project
tdc.InitConnectionEx qcServer
tdc.Login qcUser, qcPassword
tdc.Connect qcDomain, qcProject

ListItemFound = 0
cCount = ActiveSheet.UsedRange.Columns.Count
rCount = ActiveSheet.UsedRange.Rows.Count
listexists = 0

Set cust = tdc.Customization
cust.Load
Set custus = cust.Lists

For i = 1 To cCount
colconv = Chr(i + ''64'')
listname = ActiveSheet.Range(colconv & 1).Value
'MsgBox ''ListName: '' & listname

If custus.IsListExist(listname) = ''True'' Then

append = MsgBox(''Do you want to append to '' & listname & '' ?'', 4, listname & ''already exists'')

If append = vbYes Then
Set custu = custus.AddList(listname)
Set custnu1 = custu.RootNode
Set Lcustnu1 = custnu1.Children
cntLcustnu1 = custnu1.ChildrenCount

For j = 2 To rCount
ListItemFound = 0
listitem = ActiveSheet.Range(colconv & j).Value

If listitem <> '''' Then
For l = 1 To cntLcustnu1
Set ALMlistitemObj = Lcustnu1.Item(l)
ALMlistitem = ALMlistitemObj.Name
If listitem = ALMlistitem Then
ListItemFound = 1
End If
Next

If ListItemFound = 0 Then
Set custnu2 = custnu1.AddChild(CStr(listitem))
End If

End If
Next

End If

ElseIf custus.IsListExist(listname) = ''False'' Then
Set custu = custus.AddList(listname)
Set custnu1 = custu.RootNode

For j = 2 To rCount
listitem = ActiveSheet.Range(colconv & j).Value
If listitem <> '''' Then
Set custnu2 = custnu1.AddChild(CStr(listitem))
If Err.Number = -2147220424 Then
End If
End If
Next
End If

Next

cust.Commit

Set cust = Nothing
Set custus = Nothing
Set custnu2 = Nothing
Set custnu1 = Nothing
Set custu = Nothing

'Disconnect from the project and logout of QC
tdc.Disconnect
tdc.Logout

'Kill the TDConnection object
Set tdc = Nothing

Marked as spam
Posted by (Questions: 3, Answers: 168)
Answered on February 23, 2016 8:02 pm
0
Private answer

Thank you for your answer. I did not get a chance to try it but I did find an Excel Macro that does exactly what I needed. I have attached the macro for others that have a similar problem as me.

[link text][1]

[1]: /storage/temp/410-add-project-lists-values-using-exel-macro.zip

Marked as spam
Posted by (Questions: 1, Answers: 1)
Answered on February 23, 2016 10:21 pm
EyeOnTesting

Welcome back to "EyeOnTesting" brought to you by Orasi Software, Inc.

X
Scroll to Top