I have a VBScript that uses OTA API to update Project Lists using Excel input. It has been working for over a year but I recently made a small modification to it. Now the script works correctly in every project except the one that I was using to test the modification. I believe that something went wrong when I was debugging the script that corrupted the project. I do remember a message that said something like "Project metadata could not be updated".
The script takes a 2 column spreadsheet consisting of List Name and List Item. If the List Name is not the name of an existing Project List it will create it. It will add the List Item values to the corresponding lists. If it encounters an Item that already exists in the list, it will catch the duplicate entry error and skip ahead to the next row.
The problem is that the project in question seems to see every entry as a duplicate , which causes it to skip the add of the item. I have run the same script with the same input in other projects and it works as expected in those.
Luckily, adding items manually through the Customize area of the problem project works fine.
Does anyone have an idea what has happened here, and how I can fix it?
I realize it is my own fault for debugging a script in a live production project, but I am both curious to understand - and reluctant to make these updates manually!
The code is copied below.
Dim custus, listname, newlist
Sub hierlists
'This script will load lists and items to project lists
' It takes as input an excel spreadsheet with 2 columns, ListName and ListItem
' If the ListItem already exists for the ListName, the duplicate value is reported and the add is skipped.
userid = inputBox("UserID:")
password = inputBox("Password:")
dbuser = inputBox("Database Account User Name:")
dbpwd = inputBox("Database Account Password:")
environment = MsgBox ("Production?", vbYesNo, "Choose Environment")
Select Case environment
Case vbYes
'MsgBox("Server = http://hpqc_stage/qcbin/")
ToServer = "http://hpqc/qcbin/"
sserver = "MA000xssql35v4"
Case vbNo
'MsgBox("Server = http://hpqc_train/qcbin/")
ToServer = "http://hpqc_train/qcbin/"
sserver = "MA000xshpq03"
End Select
ToDomain = inputBox("To Domain:")
ToProject = inputBox("To Project: ")
'msgbox "End of Input"
'Add connection to target server & Domain
Set tdc = CreateObject("tdapiole80.tdconnection.1")
tdc.InitConnection ToServer, ToDomain
'connect toProject
tdc.ConnectProject ToProject, userid, password
msgbox "Connected to " &ToDomain &" - " &ToProject
Set cust = tdc.Customization
cust.Load
Set custus = cust.Lists
'Open Excel file
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open _
("C:\Temp\ReformattedDecomp.xlsx")
' msgbox "Opened Excel spreadsheet"
intRow = 2
listname = objExcel.Cells(intRow,1).Value
custus.AddList (listname)
Set custToList = custus.List(Cstr(listname))
NbrDups = 0
TotalRows = 0
'Loop to read item names in spreadsheet and update target database
Do Until objExcel.Cells(intRow,1).Value = ""
newlist = objExcel.Cells(intRow,1).Value
'msgbox "newlist = " & newlist
If newlist <> listname then
custus.AddList (newlist)
Set custToList = custus.List(Cstr(newlist))
listname = newlist
'msgbox "List = " & listname
end if
ItemName = objExcel.Cells(intRow,2).Value
On Error Resume Next
Set custnu1 = custToList.RootNode
Set custnu2=custnu1.Addchild("Null")
custnu2.Name = ItemName
If Err.Number <> 0 Then
'error handling:
'WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " & Err.Description
If Err.Description like "%multiple%" then
nbrDups = NbrDups + 1
'msgbox "Duplicate value at line " & intRow & " Value = " & ItemName & " Skipping item."
On Error GoTo 0
Err.Clear
'msgbox "error cleared"
End If
End if
intRow = intRow + 1
'msgbox "intRow " & intRow
Loop
msgbox "Rows read = " & intRow - 1 & ". Duplicate entries skipped = " & NbrDups & "."
msgbox "Finished"
cust.commit
tdc.DisconnectProject
tdc.ReleaseConnection
objExcel.Quit
End Sub
hierlists