Option Explicit

' FILENAME: CQExport.vbs

' PURPOSE: This script was written to export data from a ClearQuest database associated with the schema to text

' files on disk.

' The script can be used to export data from ClearQuest databases associated with different schemas...but REFERENCE_LIST fields won't be exported. A reference list is a linked field; for example, customers linked to defects.

' USAGE:

' 1. Install Windows Scripting Host.

' 2. Connect to export schema repository.

' 3. Set the short date format to mm/dd/yyyy. (date formats can be set from regional

' settings in the control panel). ClearQuest date data will be exported in this format.

' 4. Copy \\tools\CQVBScripts\CQExport.vbs to any subdirectory on your PC.

' 5. Create a temporary directory where export files will be written. If a temporary directory isn't

' specified, files will be written to the NT/Windows temporary directory.

' 6. Run CQExport.vbs.

' IMPORT NOTES:

' Existing export files will be overwritten.

' Export Files:

' cqfmtProject.txt (Data from project table)

' cqfmtCompany.txt (Data from company table)

' cqfmtCalls.txt (Data from calls table)

' cqfmtProduct.txt (Data from product table)

' cqfmtPlatform.txt (Data from platform table)

' cqfmtProductVersion.txt (Data from productversion table)

' cqfmtComponents.txt (Data from component table)

' cqfmtCustomerLinks (Calls linked to defects)

' cqfmtDuplicates.txt (Defects marked as duplicates)

' cqfmtHistory.txt (History for all entities i.e. tables. must be seperated for import)

' cqfmtDefectAttachments.txt (Files attached to defects. attachment description can't be imported.

' Each records attached file(s) are written to subdirectory.

' The subdirectory is given the name of the defect records dbid.

' file is written to its own subdirectory)

' cqfmtDefect.txt (Defect export file doesn't include MULTILINE_TEXT or REFERENCE_LIST data)

' cqfmtParent.txt

' cqfmtChild.txt

' Note: There will be export files for all entities but you only need the files listed above.

' Data from mutiline text fields are written to seperate files in the following format:

' cqfmt##MultiLineText.txt where ## is the name of the MultiLineText field.

' Data should be imported in the following order:

' Project

' Products

' Product Versions, Platforms, and Components can be imported in any order after Products

' Company

' Calls

' Defects

' Attachments, History, and Duplicates can be imported in any order after Defects

' Map Clone data (run CQMapConeData.vbs)

' Import Clone data into import database

' IMPORTANT

' Field names in the import file are always mapped to the same field names on the import grid regardless of

' how an import map was saved. This means you must manually map field names that are mapped to

' different field names.

' The following are the field names that have to be mapped to different field names.

' DEFECTS

' These mappings must be made to import attachments, history, and duplicates:

' old_id = idold_internal_id = dbid

' The old Track or PMR id stored in old_id will not be retained.

' DEFECT ATTACHMENTS

' The attachment mapping are:

' attachments = attachments

' old_internal_id = dbid

' The description is defaulted to "Imported Attachment" when attachments are imported.

' You have to manually update the description to its original value.

' DEFECT DUPLICATES

' Importing duplicates is confusing so I've included the import steps.

' On the Setup Destination Entity and Data type to import dialog enter:

' Select Destination Entity: Defect

' Import Option: Records

' Check upgrade existing records

' Import field without state information

' Check import duplicates

' Imported field containing Duplicate info:duplicateId

' ClearQuest field containing original id: old_id

' Click on Next button

' On the Setup Field Mapping screen, map old_id = id.

' DEFECT HISTORY

' History for all entities is exported to fmtcqhistory.txt. This means that you have to select records where

' entitydef_name equals defect, cut and paste into a new text file.

' The history mapping is entity_dbid = old_id.

'------------------- FieldTypes ------------------------------------------------------------

Const AD_SHORT_STRING = 1 ' SHORT_STRING: Simple text field (100 character limit)

Const AD_MULTILINE_STRING = 2 ' MULTILINE_STRING: Arbitrarily long text

Const AD_INT = 3 ' INT: Numbers

Const AD_DATE_TIME = 4 ' DATE_TIME: Timestamp

Const AD_REFERENCE = 5 ' REFERENCE: "pointer" to another (aux) table

Const AD_REFERENCE_LIST = 6 ' REFERENCE_LIST: list of references

Const AD_ATTACHMENT_LIST = 7 ' ATTACHMENT_LIST: list of attached files

Const AD_ID = 8 ' ID: special: string ID for entity

Const AD_STATE = 9 ' STATE: special: state of request entity

Const AD_JOURNAL = 10 ' JOURNAL: special: list of rows in a subtable belonging exclusively to this entity

Const AD_DBID = 11 ' DBID: special: internal numeric id

'------------------- File processing constants ------------------------------------------------

Const ForReading = 1

Const ForWriting = 2

Const ForAppending = 8

Const TristateUseDefault = -2

Const TristateTrue = -1

Const TristateFalse = 0

' ------------------- ClearQuest recordset constants --------------

Const AD_SUCCESS = 1

Const AD_NO_DATA_FOUND = 2

Const AD_MAX_ROWS_EXCEEDED = 3

' ------------------- BoolOp -------------------

Const AD_BOOL_OP_AND = 1

Const AD_BOOL_OP_OR = 2

' ------------------- CompOp -------------------

Const AD_COMP_OP_EQ = 1

Const AD_COMP_OP_NEQ = 2

Const AD_COMP_OP_LT = 3

Const AD_COMP_OP_LTE = 4

Const AD_COMP_OP_GT = 5

Const AD_COMP_OP_GTE = 6

Const AD_COMP_OP_LIKE = 7

Const AD_COMP_OP_NOT_LIKE = 8

Const AD_COMP_OP_BETWEEN = 9

Const AD_COMP_OP_NOT_BETWEEN = 10

Const AD_COMP_OP_IS_NULL = 11

Const AD_COMP_OP_IS_NOT_NULL = 12

Const AD_COMP_OP_IN = 13

Const AD_COMP_OP_NOT_IN = 14

' -------------------- Constant from adovbs.inc -------------------

Const adOpenStatic = 3

' ---------------------- Global Variables ------------------------

Dim blnProgressMsg ' set to true to display progress message(s). Otherwise, false.

Dim blnDebug ' set to true to display msgbox diagnostic messages. Otherwise, false.

Dim strCQDatabase

Dim strCQProduct

Dim strProductList

' -------------------------------------------------------------------

blnDebug = False

blnProgressMsg = False

Call Welcome ()

Call Main ()

' ======================== Subroutines ===========================

' ------------------------------------------------------------------

' Subroutine: Main

' Purpose:

' Inputs:

' Returns:

' -------------------------------------------------------------------

Sub Main ()

on error resume next

Const cntMaxMultiLine = 10

Dim blnExportDefects

Dim cn

Dim column

Dim ColumnName

Dim CQDatabases

Dim databases

Dim dbDescription

Dim db

Dim dbDesc

Dim dbName

Dim dbSetName

Dim diskSpace

Dim entityDefNames

Dim entityDefObj

Dim f

Dim fieldname

Dim fieldType

Dim fso

Dim i

Dim MultiLineText() ' Array of MULTILINE_TEXT fields.

Dim MyEntityTypes()

Dim MyDate

Dim Name

Dim nameList

Dim num_columns

Dim num_records

Dim querydef

Dim rs

Dim rsltset

Dim session

Dim StateNameList

Dim strDbNames

Dim strPassword

Dim strTempValue

Dim strTempValueESC

Dim strUser

Dim status

Dim strOut

Dim strFilePath

Dim strFieldNames

Dim tFolder

Dim ts

Dim ts1

Dim ts2

Dim ts3

Dim x

blnExportDefects = False

tFolder = ""

Set session = CreateObject("CLEARQUEST.SESSION")

strUser = trim(InputBox("Enter ClearQuest Login ID:", , "admin"))

strPassword = trim(InputBox("Enter ClearQuest Password:", ,"bulldog"))

' -------------------------------------------------

' Get ClearQuest databases accessible to login id.

' -------------------------------------------------

strDbNames = ""

databases = session.GetAccessibleDatabases ("MASTR", "", "")

For Each db in databases

dbName = db.GetDatabaseName

dbDescription = db.GetDescription

dbSetName = db.GetDatabaseSetName

If blnDebug Then msgbox "Database= " & dbName

If strDbNames = "" Then

strDbNames = db.GetDatabaseName & vbtab & dbDescription & vbcrlf & dbSetName

Else

strDbNames = strDbNames & db.GetDatabaseName & vbtab & dbDescription & vbcrlf & dbSetName

End If

strCQDatabase = trim(InputBox("Enter the logical ClearQuest database from which to export data." & vbcrlf & vbcrlf & "Accessible Databases:" & vbcrlf & strDbNames))

If strUser = "" or strPassword = "" or strCQDatabase = "" Then

msgbox "A ClearQuest username, password, and database are required " & _

"to run export script."

WScript.Quit

End If

session.UserLogon strUser, strPassword, strCQDatabase, 1, ""

If err.Description <> "" Then

msgbox "Unable to login to ClearQuest database." & vbcrlf & _

"VBScript Error: " & err.Description

WScript.Quit

End If

tFolder = trim(InputBox("Enter an export directory or leave blank for files to be written to Windows temporary directory."))

If tFolder = "" Then

If msgbox ("Do you want to cancel export?", vbyesno) = vbyes Then

msgbox "here"

WScript.Quit

End If

' -------------------------------------

' Clear array of MUTLILINE_TEXT fields.

' -------------------------------------

ReDim MultiLineText(cntMaxMultiLine)

ReDim MyEntityTypes(cntMaxMultiLine)

For i = 0 to (cntMaxMultiLine - 1)

MultiLineText(i) = ""

MyEntityTypes(i) = ""

i = 0

' ------------------------------------

' Get the NT/Windows temporary folder.

' ------------------------------------

If tFolder = "" Then

tFolder = GetTemporaryFolder

End If

Set fso = CreateObject("Scripting.FileSystemObject")

strFilePath = tFolder & "\cqExportReadMe" & ".txt"

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts2 = f.OpenAsTextStream(ForWriting, TristateFalse)

ts2.Write "ClearQuest Database: " & strCQDatabase & vbcrlf

ts2.Write "Export Date/Time: " & Now() & vbcrlf & vbcrlf

ts2.Write "Defect Customer links: cqfmtcustomer_link.txt."

ts2.Write vbcrlf

ts2.Write "Defect Duplicates: cqfmtDuplicates.txt. Unduplicate state info is exported with Defects."

ts2.Write vbcrlf

ts2.Write "Records for each entity type is exported seperately." & vbcrlf & _

"The naming convention is cqfmt## where ## is the name of the entity."

ts2.Write vbcrlf

ts2.Write "History for all entities is exported to cqfmtHistory.txt. Export file requires seperating the history for entities before importing."

ts2.Write vbcrlf

ts2.Write "MULTILINE_TEXT fields are exported seperately." & vbcrlf & _

"The naming convention is cqfmt##MultiLineText where ## is the name of the MULTILINE_TEXT field."

strFilePath = tFolder & "\cqfmtDuplicates" & ".txt"

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts1 = f.OpenAsTextStream(ForWriting, TristateFalse)

ts1.Write """" & "id" & """" & "|" & """" & "duplicateId" & """" & vbcrlf

i = 0

entityDefNames = session.GetEntityDefNames

for each name in entityDefNames

If name = "Defect" Then

blnExportDefects = True

End If

Set querydef = session.BuildQuery(name)

strFilePath = tFolder & "\cqfmt" & trim(name) & ".txt"

If blnProgressMsg Then

msgbox "Exporting " & name & " data to " & strFilePath & "." & vbcrlf & _

"Click OK to continue export!", vbInformation, "Export Data"

End If

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts = f.OpenAsTextStream(ForWriting, TristateFalse)

If blnDebug Then msgbox "Entity Type: " & name, vbInformation

set entityDefObj = session.GetEntityDef(name)

nameList = entityDefObj.GetFieldDefNames()

For Each fieldName in nameList

fieldType = entityDefObj.GetFieldDefType(fieldname)

If fieldName <> "is_active" and fieldName <> "lock_version" and _

fieldName <> "locked_by" and fieldName <> "version" and _

fieldName <> "dupl_id" and _

fieldName <> "parentSCR" and fieldName <> "children" Then

If fieldType = AD_MULTILINE_STRING Then

MultiLineText(i) = fieldName

MyEntityTypes(i) = name

i = i + 1

ts2.Write fieldname & vbcrlf

ElseIf fieldType = AD_JOURNAL and name <> "History" Then

ElseIf fieldType = AD_ATTACHMENT_LIST Then

ElseIf fieldType = AD_REFERENCE_LIST Then

' REFERENCE_LIST fields are exported to seperate files because a record is exported

' for every value in the list. For example, if a defect record has 3 customer links,

' the record will be written to the export file for every link.

Else

querydef.BuildField(fieldName)

If strFieldNames = "" Then

strFieldNames = """" & trim(fieldName) & """"

Else

strFieldNames = strFieldNames & "|" & """" & trim(fieldName) & """"

End If

ts.Write strFieldNames

strFieldNames = ""

Set rsltset = session.BuildResultSet(querydef)

rsltset.Execute

num_columns = rsltset.GetNumberOfColumns

num_records = 0

status = rsltset.MoveNext

Do While status = AD_SUCCESS

num_records = num_records + 1

If blnDebug Then msgbox "Record #" & num_records, vbInformation

column = 1

' Columns are numbered from 1 to N, not 0 to N-1.

Do While column <= num_columns

ColumnName = rsltset.GetColumnLabel(column)

If IsNull(rsltset.GetColumnValue(column)) Then

strTempValue = ""

Else

fieldType = entityDefObj.GetFieldDefType(rsltset.GetColumnLabel(column))

strTempValue = rsltset.GetColumnValue(column)

If name = "attachments" Then

If ColumnName = "entity_dbid" Then

SaveAttachmentsToDisk session, strTempValue, tFolder, blnDebug

ElseIf ColumnName = "filename" Then

strTempValue = tfolder & "\" & strTempValue

End If

ElseIf fieldType = AD_DATE_TIME and strTempValue <> "" Then

If blnDebug Then msgbox "Before CDate : " & strTempValue, vbInformation

strTempValue = Left(rsltset.GetColumnValue(column), 10)

MyDate = CDate(strTempValue)

If blnDebug Then msgbox "After CDate : " & MyDate, vbInformation

strTempValue = CStr(FormatDateTime(MyDate, vbShortDate))

If blnDebug Then msgbox "After Format : " & strTempValue, vbInformation

ElseIf ColumnName = "id" Then

' State information isn't included in the duplicates import file...but isn't needed.

' The unduplicate state information is included in the defects import file...so

' state information isn't needed when duplicates are imported.

MyGetDuplicates session, strTempValue, tFolder, ts1

End If

strTempValueESC = EscapeQuotes(Trim(strTempValue))

If blnDebug Then msgbox "strTempESC: " & strTempValueESC, vbInformation

If (column = 1 and (num_columns > column)) Then

strOut = """" & strTempValueESC & """" & "|"

Else

If column = num_columns Then

strOut = strOut & """" & strTempValueESC & """"

Else

strOut = strOut & """" & strTempValueESC & """" & "|"

End If

If blnDebug Then msgbox "Field Names written as first row to export file: " & strValues, vbInformation

column = column + 1

Loop

ts.write vbcrlf & strOut

strOut = ""

strTempValueESC = ""

strTempValue = ""

status = rsltset.MoveNext

Loop

ts.close

ts1.close

ts2.close

' ---------------------------------------------

' Export REFERENCE_LIST data to seperate files.

' ---------------------------------------------

If blnExportDefects Then

' -------------------------

' Export Defect Call links.

' -------------------------

strFilePath = tFolder & "\cqfmtCustomerLinks" & ".txt"

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts3 = f.OpenAsTextStream(ForWriting, TristateFalse)

ts3.Write """" & "id" & """" & "|" & """" & "Customer_link" & """" & "|" & """" & "State" & """"

ExportCustomerLinks ts3, "Defect", session

ts3.close

' -------------------------

' Export clone parent data.

' -------------------------

strFilePath = tFolder & "\cqfmtParentSCR" & ".txt"

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts3 = f.OpenAsTextStream(ForWriting, TristateFalse)

ExportParentData session, ts3

ts3.close

' ------------------------

' Export clone child data.

' ------------------------

strFilePath = tFolder & "\cqfmtChildren" & ".txt"

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts3 = f.OpenAsTextStream(ForWriting, TristateFalse)

ExportChildData session, ts3

ts3.close

End If

' ---------------------------------------------------------------------------

' Export MULTILINE_TEXT data.

' Note: MULITLINE_TEXT data can't be queried using ClearQuest API or online.

' ---------------------------------------------------------------------------

msgbox "Exporting MULTILINE_TEXT data." & vbcrlf, vbInformation

Set cn = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.RecordSet")

Set dbDesc = session.GetSessionDatabase

If blnDebug Then

msgbox "DB connect string = " & dbDesc.GetDatabaseConnectString

End If

cn.Open dbDesc.GetDatabaseConnectString

Set rs.ActiveConnection = cn

rs.CursorType = adOpenStatic

i = 0

Do While MultiLineText(i) <> "" and (i < cntMaxMultiLine)

strFilePath = tFolder & "\cqfmt" & Trim(MultiLineText(i)) & "MultiLineText" & ".txt"

fso.CreateTextFile strFilePath

Set f = fso.GetFile(strFilePath)

Set ts3 = f.OpenAsTextStream(ForWriting, TristateFalse)

ExportMULTILINE_TEXT MultiLineText(i), MyEntityTypes(i), ts3, rs, session

ts3.close

i = i + 1

Loop

msgbox "ClearQuest database export is Complete." & vbcrlf & _

"Export files are in " & tfolder & "." & vbcrlf & vbcrlf & _

"Note: Export files are prefixed with cqfmt# " & vbcrlf & _

"where # is the entity definition name.", vbInformation, "Export Complete"

End Sub

' --------------------------------------------------------------------

' Subroutine: ExportMULTILINE_TEXT

' Purpose:

' Inputs:

' Returns:

' ---------------------------------------------------------------------

Sub ExportMULTILINE_TEXT (strMultiLineText, strMyEntity, ts3, rs, session)

Dim strOut

Dim strSQL

Dim strTempValue

Dim strTempValueESC

Dim strSQLSELECT

Dim strSQLFROM

Dim i

Dim StateType

Dim iz

If IsStateBased (strMyEntity, session) Then

strSQLSELECT = "SELECT Defect.id, Defect.old_id, statedef.name as state, statedef.entitydef_id, "

strSQLFROM = " FROM (" & strMyEntity & " INNER JOIN statedef ON Defect.state = statedef.id)"

strOut = """" & "id" & """" & "|" & """" & "old_id" & """" & "|" & """" & "state" & """" & "|" & """" & trim(strMultiLineText) & """"

Else

strSQLSELECT = "SELECT id, old_id, "

strSQLFROM = " FROM " & strMyEntity & ""

strOut = """" & "id" & """" & "|" & """" & "old_id" & """" & "|" & """" & trim(strMultiLineText) & """"

End If

ts3.write strOut

ts3.write vbcrlf

strSQL = strSQLSELECT

strSQL = strSQL & strMultiLineText

strSQL = strSQL & strSQLFROM

If blnDebug Then

msgbox "strSQL= " & strSQL, vbInformation

End If

rs.Open strSQL

Do Until rs.EOF

strTempValue = rs.fields(strMultiLineText)

strTempValueESC = EscapeQuotes(trim(strTempValue))

strOut = """" & Trim(rs.fields("id")) & """" & "|" & """" & Trim(rs.fields("old_id")) & """" & "|" & """" & Trim(rs.fields("state")) & """" & "|" & """" & strTempValueESC & """" & vbcrlf

ts3.write strOut

strOut = ""

rs.MoveNext

Loop

strSQL = ""

strOut = ""

strTempValue = ""

strTempValueESC = ""

rs.close

End Sub

' --------------------------------------------------------

' Subroutine: Welcome

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------------------

Sub Welcome ()

Dim L_Welcome_Msgbox_Message_Text

Dim L_Welcome_Msgbox_Title_Text

Dim intDoIt

L_Welcome_MsgBox_Message_Text = "This script exports data from a ClearQuest database."

L_Welcome_MsgBox_Title_Text = "ClearQuest Data Export Script"

intDoIt = MsgBox(L_Welcome_MsgBox_Message_Text, _

vbOKCancel + vbInformation, _

L_Welcome_MsgBox_Title_Text )

If intDoIt = vbCancel Then

WScript.Quit

End If

End Sub

' --------------------------------------------------------

' Function: EscapeQuotes

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------------------

Function EscapeQuotes(strTempValue)

on error resume next

err.clear

Dim Target

Dim iStrLen

Dim i, j

Dim TempStr

Dim CloseQuoteFound

Dim fmtString

Target = """"

iStrLen = Len(strTempValue)

fmtString = ""

i = 1

Do While i <= iStrLen

If Mid(strTempValue, i, 1) = Target Then

If fmtString = "" Then

fmtString = Mid(strTempValue, i, 1) & """"

Else

fmtString = fmtString & Mid(strTempValue, i, 1) & """"

End If

Else

If fmtString = "" Then

fmtString = Mid(strTempValue, i, 1)

Else

fmtString = fmtString & Mid(strTempValue, i, 1)

End If

i = i + 1

Loop

EscapeQuotes = Trim(fmtString)

End Function

' --------------------------------------------------------

' Function: GetTemporaryFolder

' Purpose: Get NT/Windows temporary folder.

' Inputs:

' Returns:

' --------------------------------------------------------

Function GetTemporaryFolder

on error resume next

err.clear

Dim fso, f, tfolder

Set fso = CreateObject("Scripting.FileSystemObject")

Const TemporaryFolder = 2

Set tfolder = fso.GetSpecialFolder(TemporaryFolder)

GetTemporaryFolder = tfolder

End Function

' --------------------------------------------------------

' Function: GetDiskSpace

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------------------

Function GetDiskSpace (tfolder)

on error resume next

err.clear

Dim fso, d, s

Dim drvPath

'msgbox tfolder

drvPath = Left(tfolder,3)

Set fso = CreateObject("Scripting.FileSystemObject")

Set d = fso.GetDrive(fso.GetDriveName(drvPath))

s = "Drive " & UCase(drvPath) & " - "

s = s & d.VolumeName & "<BR>"

s = s & "Available Space: " & FormatNumber(d.AvailableSpace/1024, 0)

s = s & " Kbytes"

GetDiskSpace = FormatNumber(d.AvailableSpace/1024, 0)

End Function

' -----------------------------------------------------------------

' Purpose: Save Attachments to disk.

' Inputs:

' Returns:

' -----------------------------------------------------------------

Function SaveAttachmentsToDisk (session, CQDBID, tFolder, blnDebug)

on error resume next

err.clear

Dim entityObj

Dim i

Dim strMyFileName

Dim strMyDescription

Dim rsltset

Dim intNumAttachments

Dim attachFields

Dim attachField1

Dim attachments

'check for enough disk space check attachment filesize field.

msgbox "in function dbid " & CQDBID

Set entityObj = session.GetEntityByDbId("Defect", CQDBID)

' Save attachments to disk.

Set attachFields = entityObj.AttachmentFields

Set attachField1 = attachFields.Item(0)

Set attachments = attachField1.attachments

intNumAttachments = attachments.Count

msgbox intNumAttachments

msgbox err.description

If blnDebug then msgbox "Number Of Attachments " & intNumAttachments

For i = 0 To intNumAttachments - 1

Set Myattachment = attachments.Item(i)

strMyFileName = Myattachment.FileName

strMyDescription = Myattachment.Description

If blnDebug Then Msgbox strMyFileName

msgbox "tfoler= " & tfolder

msgbox "file name= " & strMyFileName

strMyFileName = tfolder & "\" & CQDBID & "\" & strMyFileName

If blnDebug Then Msgbox strMyFileName

Myattachment.Load strMyFileName

SaveAttachmentsToDisk = True

End Function

' -----------------------------------------------------------------

' Subroutine: MyGetDuplicates

' Purpose:

' Inputs:

' Returns:

' -----------------------------------------------------------------

Function MyGetDuplicates (session, CQID, tFolder, ts1)

on error resume next

err.clear

Dim duplicateLinkList ' Array of all direct duplicates of this Entity

Dim duplicateLink ' Variant containing a Link to a duplicate

Dim duplicateObj ' The same Link, but as an Object rather than a Variant

'CQID is the parent The current Entity's display name (ID string)

Dim f

Dim duplicateId

Dim ts

Dim strFilePath

Dim entityObj

Dim dups

Dim dupvar

Dim dupobj

Dim blnHasDups

Dim entity

Set entityObj = session.GetEntity ("Defect", CQID)

blnHasdups = entityObj.HasDuplicates

If blnHasdups Then

'msgbox "Has Duplicates? " & blnHasdups

'parent record

Set entityObj = session.GetEntity("Defect", CQID)

dups = entityObj.GetDuplicates

' Find all duplicates of parent.

For Each dupvar In dups

Set dupobj = dupvar

Set entity = dupobj.GetChildEntity

duplicateId = entity.GetDisplayName

'msgbox "duplicate_Id " & duplicateId

'msgbox "processing duplicates"

'msgbox "CQID " & CQID

'msgbox "tFolder " & tFolder

'msgbox "duplicateid " & duplicateId

ts1.Write """" & CQID & """" & "|" & """" & duplicateId & """"

'msgbox err.description

End If

End Function

' --------------------------------------------------------

' Subroutine: ExportCustomerLinks

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------------------

Sub ExportCustomerLinks (ts3, name, session)

Dim column

Dim entityDefObj

Dim num_columns

Dim num_records

Dim querydef

Dim rsltset

Dim status

Dim strTempValue

Dim strOut

Set querydef = session.BuildQuery(name)

querydef.BuildField("id")

querydef.BuildField("Customer_link")

querydef.BuildField("state")

Set rsltset = session.BuildResultSet(querydef)

rsltset.Execute

num_columns = 3

status = rsltset.MoveNext

Do While status = AD_SUCCESS

num_records = num_records + 1

If blnDebug Then msgbox "Record #" & num_records, vbInformation

column = 1

' Columns are numbered from 1 to N, not 0 to N-1.

Do While column <= num_columns

If IsNull(rsltset.GetColumnValue(column)) Then

strTempValue = ""

Else

strTempValue = rsltset.GetColumnValue(column)

If (column = 1 and (num_columns > column)) Then

strOut = """" & strTempValue & """" & "|"

Else

If column = num_columns Then

strOut = strOut & """" & strTempValue & """"

Else

strOut = strOut & """" & strTempValue & """" & "|"

End If

If blnDebug Then msgbox "Field Names written as first row to export file: " & strValues, vbInformation

column = column + 1

Loop

ts3.write vbcrlf & strOut

strTempValue = ""

strOut = ""

status = rsltset.MoveNext

Loop

End Sub

' --------------------------------------------

' Subroutine: ExportChildData

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------

Sub ExportChildData (session, ts3)

' select the id and state. do a getentity to return the child record. do a getvalueaslist to

' get the children and then write a record for each child to the file.

Dim rsObj

Dim status

Dim strSQL

Dim strOut

Dim rsltset

Dim querydef

ts3.Write strCQDatabase

ts3.write vbcrlf

Set querydef = session.BuildQuery("Defect")

querydef.BuildField("id")

querydef.BuildField("Children")

querydef.BuildField("state")

Set rsltset = session.BuildResultSet(querydef)

rsltset.Execute

status = rsltset.MoveNext

Do While status = AD_SUCCESS

strOut = Trim(rsltset.GetColumnValue(1)) & Trim(rsltset.GetColumnValue(2)) & Trim(rsltset.GetColumnValue(3))

ts3.write strOut

ts3.write vbcrlf

strOut = ""

status = rsltset.MoveNext

Loop

End Sub

' --------------------------------------------

' Subroutine: CreateProductList

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------

Function CreateProductList (session)

Dim rsltset

Dim status

Dim strSQL

Dim strProductList

strProductList = ""

strSQL = "select prodname from Product order by prodname"

If blnDebug Then msgbox "strSQL " & strSQL, vbInformation

set rsltset = session.BuildSQLQuery(strSQL)

rsltset.Execute

status = rsltset.MoveNext

Do While status = AD_SUCCESS

If strProductList = "" Then

strProductList = Trim(rsltset.GetColumnValue(1)) & vbcrlf

Else

strProductList = strProductList & Trim(rsltset.GetColumnValue(1)) & vbcrlf

End If

status = rsltset.MoveNext

Loop

CreateProductList = strProductList

End Function

' --------------------------------------------

' Subroutine: ExportParentData

' Purpose:

' Inputs:

' Returns:

' --------------------------------------------

Sub ExportParentData (session, ts3)

' find the new parentSCR in the import database.

Dim filternode

Dim rsltset

Dim status

Dim strSQL

Dim strOut

Dim querydef

ts3.Write strCQDatabase

ts3.write vbcrlf

Set querydef = session.BuildQuery("Defect")

querydef.BuildField("id")

querydef.BuildField("parentSCR")

querydef.BuildField("state")

Set rsltset = session.BuildResultSet(querydef)

set filternode = querydef.BuildFilterOperator (AD_BOOL_OP_AND)

filternode.BuildFilter "parentSCR", AD_COMP_OP_IS_NOT_NULL

rsltset.Execute

status = rsltset.MoveNext

Do While status = AD_SUCCESS

strOut = Trim(rsltset.GetColumnValue(1)) & Trim(rsltset.GetColumnValue(2)) & Trim(rsltset.GetColumnValue(3))

ts3.write strOut

ts3.write vbcrlf

strOut = ""

status = rsltset.MoveNext

Loop

'Set rsltset = nothing

End Sub

' -----------------------------------------------------

' Function: IsStateBased

' Purpose: Determines whether an entity is state based.

' Inputs:

' Returns:

' -----------------------------------------------------

Function IsStateBased (strMyEntity, session)

Dim entityDefNames

Dim name

IsStateBased = False

' Get the list of names of the state-based record types.

entityDefNames = session.GetReqEntityDefNames

for each name in entityDefNames

If name = strMyEntity Then

IsStateBased = True

End If

End Function

' ======================== End Subroutines ========================