The report shows you the change status that have been done on a bug between 2 dates.

 

Prerequisit: every time a change status is done (Bug_FieldCanChange = True) the field must be locked (ReadOnly = True)

 

The report consists of these fields:

• Bug ID
• Detected Date
• User
• Status Change Date
• Old Value
• New Value

 

For this type of extraction I need to work on 2 tables which detected attribute info about History, if the attribute has been under AUDIT:

AUDIT_LOG and AUDIT_PROPERTIES.

 

I will execute this query:

"Select bg_bug_id as ID_Bug, bg_detection_date as DetectedDate, T1.au_user as User, T1.au_time as DateOfChange, T2.ap_old_value as OldValue, T2.ap_new_value as NewValue " & _
"from BUG join (select au_user, au_action_id, au_entity_type, au_entity_id, au_time from audit_log) as T1 on T1.au_entity_id = bg_bug_id " &

"join (select ap_action_id, ap_old_value, ap_new_value,ap_field_name from audit_properties) as T2 on T2.ap_action_id = T1.au_action_id " & _
  "where (T1.au_time >= '" & dtFrom & "' and T1.au_time < DATEADD(day,1,'" & dtTo & "')) and (T1.au_entity_type like 'BUG') and (T2.ap_field_name like 'BG_STATUS') " & _
"ORDER BY 1,4 "

 

"dtFrom" and "dtTo" will be 2 variables about the range date.

 

________________________________________________________________________

 

Details and Implementation

 

These are the 3 steps for the scope:

• Creation of a custom button in the Defect module to call the Action called actReportStatusChange
• Put the code into the ActionCanExecute event to call the Sub in Defect Module.
• Creation of the Sub call Defect_ReportStatusChange in Defect Module

 

1. For the 1st point see the WorkFlow Script Editor section

 

2. Call of the Sub in the ActionCanExecute Function

Function ActionCanExecute(ActionName)

On Error Resume Next

Dim Res

Res = True

  

if ActionName = "actReportStatusChange" then Defect_ReportStatusChange

  

ActionCanExecute = Res

On Error Goto 0

End Function

 

 

3. Code of the Defect_ReportStatusChange

Sub Defect_ReportStatusChange

On Error Resume Next

Dim DateFrom, DateTo, dtFrom, dtTo

Dim MyComm, RecSet, i, strQuery, bolCreaExcel

Dim objXLS, objWkb, objWks

 

'this booleano will change to True if something has been extract

bolCreaExcel = False  

 

DateFrom = InputBox("Insert Begin Date","Quality Center - Start Date", "01/01/2010")

  

if DateFrom = "" then Exit Sub

  

DateTo = InputBox("Insert End Date","Quality Center - End Date", date)

  

if DateTo = "" then Exit Sub

  

  

'Check only if DateFrom < DateTo

if CDate(DateFrom) > CDate(DateTo) then

     msgbox "Error on Date!", vbCritical + vbSystemModal, "Date Error"

     exit Sub

end if

  

'Date Format as MM/GG/AAAA

dtFrom = split(DateFrom,"/")(1) & split(DateFrom,"/")(0) & split(DateFrom,"/")(2)

dtTo = split(DateTo,"/")(1) & split(DateTo,"/")(0) & split(DateTo,"/")(2)

  

'Load the Query into a string variable

strQuery = 

"Select bg_bug_id as ID_Bug, bg_detection_date as DetectedDate, T1.au_user as User, T1.au_time as DateOfChange, T2.ap_old_value as OldValue, T2.ap_new_value as NewValue " & _
"from BUG join (select au_user, au_action_id, au_entity_type, au_entity_id, au_time from audit_log) as T1 on T1.au_entity_id = bg_bug_id " &

"join (select ap_action_id, ap_old_value, ap_new_value,ap_field_name from audit_properties) as T2 on T2.ap_action_id = T1.au_action_id " & _
  "where (T1.au_time >= '" & dtFrom & "' and T1.au_time < DATEADD(day,1,'" & dtTo & "')) and (T1.au_entity_type like 'BUG') and (T2.ap_field_name like 'BG_STATUS') " & _
"ORDER BY 1,4 "

  

'Creation of the Command object

set MyComm = TDConnection.Command

'Load the query to be execute

MyComm.CommandText = strQuery

 

'Exec the Query

set RecSet = MyComm.Execute

 

if RecSet.RecordCount > 0 then

   bolCreaExcel = True

end if

 

 

if bolCreaExcel then

   'Create the Excel Sheet

   set objXLS = CreateObject("Excel.Application")

   objXLS.Visible = False

   set objWkb = objXLS. WorkBooks.Add

   set objWks = objWkb.WorkSheets(1)

   objWks.Name = "Defect Trend"

 

   'excel sheet header

   objWks.Cells(1,1).Value = "Bug ID"

   objWks.Cells(1,2).Value = "Detected Date"

   objWks.Cells(1,3).Value = "User"

   objWks.Cells(1,4).Value = "Status Change Date"

   objWks.Cells(1,5).Value = "Old Value"

   objWks.Cells(1,6).Value = "New Value"

 

   'Go to the 1st record

   RecSet.First

 

   'load the Row and Column number

   intRow = RecSet.RecordCount

   intCol = RecSet.ColCount 

 

   'RecordSet Cycle

   Do while Not(RecSet.EOR)

        for j = 2 to intRow + 1

            for i = 0 to intCol - 1

                 objWks.Cells(j,i+1).Value = RecSet.FieldValue(i)

            next

        next     

        RecSet.Next

   Loop

 

   'Save the Excel File

   objWkb.SaveAs "c:\temp\DefectTrend_" & split(date,"/")(2) & split(date,"/")(1) & split(date,"/")(0) & ".xls"

 

   objWkb.Close

   objXLS.Quit

 

 else

 

   msgbox "No Change Status for Defects in the period: " & dtFrom & " - " & dtTo, vbExclamation + vbSystemModal, "QC - No Data Found"

 

end if

 

set objWks = Nothing

set objWkb = Nothing

set objXLS = Nothing

 

set RecSet = Nothing

set MyComm = Nothing

 

 

 

On Error Goto 0

End Sub

 

______________________________________________________________________ 

 

Pag: <    >