Ho scritto un codice che si collegherà a ALM 12.53 e l'esportazione dei difetti o qualsiasi altro report in Excel. È necessario avere Tool => Reference..OTA COM Type Library check in Excel 2013. Ho avuto problemi con il codice HTML quindi ho aggiunto poche righe al di sotto per rimuovere il tag HTML dai campi di Excel.
Sub Main()
Const QCADDRESS = "http://xxx:xxx/qcbin"
Const DOMAIN = "xxxx"
Const PROJECT = "xxxx"
Const QCUSR = "xxxx"
Const QCPWD = "xxxx"
Dim QCConnection, com, recset
Dim XLS, Wkb, Wks, i
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx QCADDRESS
QCConnection.Login QCUSR, QCPWD
QCConnection.Connect DOMAIN, PROJECT
QCConnection.IgnoreHtmlFormat = True
Set com = QCConnection.Command
com.CommandText = "SELECT BUG.BG_BUG_ID /*Defect.Defect ID*/ as defectid , " _
& "BUG.BG_STATUS /*Defect.State*/ as state ," _
& "BUG.BG_USER_TEMPLATE_15 /*Defect.Root Cause*/ RootCause, " _
& "BUG.BG_USER_02 /*Defect.Assigned To*/ as AssignedTo, " _
& "BUG.BG_DETECTION_DATE /*Defect.Detected on Date*/ as detectiondate, " _
& "BUG.BG_USER_01 /*Defect.Application Involved*/ as ApplicationInvolved, " _
& "BUG.BG_SUMMARY /*Defect.Summary*/ as summary , " _
& "BUG.BG_DESCRIPTION /*Defect.Description*/ as description, " _
& "BUG.BG_SEVERITY /*Defect.Severity*/ as severity , " _
& "BUG.BG_DETECTED_BY /*Defect.Submitter*/ as submitter , " _
& "BUG.BG_RESPONSIBLE /*Defect.Assignee*/ as Assignee, " _
& "BUG.BG_USER_04 /*Defect.Workstream*/ as workstream , " _
& "BUG.BG_USER_03 /*Defect.Commited Resolution Date*/ as CommitedResolutionDate, " _
& "BUG.BG_USER_05 /*Defect.Vendor Ticket Number*/ as Vendorticketnumber, " _
& "BUG.BG_DEV_COMMENTS /*Defect.Comments*/ as comments " _
& "FROM BUG /*Defect*/ " _
& "where BG_Status = 'Cancelled' " _
& "order by BUG.BG_DETECTION_DATE,BUG.BG_USER_TEMPLATE_15"
Set recset = com.Execute
Set XLS = CreateObject("Excel.Application")
XLS.Visible = False
QCConnection.IgnoreHtmlFormat = True
Set Wkb = XLS.Workbooks.Add
Set Wks = Wkb.Worksheets(1)
'Wks.Name "DataFromBugQuery"
i = 1
Wks.Cells(i, 1).Value = "Defect ID"
Wks.Cells(i, 2).Value = "State"
Wks.Cells(i, 3).Value = "Root Cause"
Wks.Cells(i, 4).Value = "Assigned To"
Wks.Cells(i, 5).Value = "Detection Date"
Wks.Cells(i, 6).Value = "Application Involved"
Wks.Cells(i, 7).Value = "Summary"
Wks.Cells(i, 8).Value = "Description"
Wks.Cells(i, 9).Value = "Severity"
Wks.Cells(i, 10).Value = "Submitter"
Wks.Cells(i, 11).Value = "Assignee"
Wks.Cells(i, 12).Value = "Workstream"
Wks.Cells(i, 13).Value = "Commited Resolution Date"
Wks.Cells(i, 14).Value = "Vendor Ticket Number"
Wks.Cells(i, 15).Value = "Comments"
If recset.RecordCount > 0 Then
i = 2
recset.First
Do While Not (recset.EOR)
Wks.Cells(i, 1).Value = recset.FieldValue(0)
Wks.Cells(i, 2).Value = recset.FieldValue(1)
Wks.Cells(i, 3).Value = recset.FieldValue(2)
Wks.Cells(i, 4).Value = recset.FieldValue(3)
Wks.Cells(i, 5).Value = recset.FieldValue(4)
Wks.Cells(i, 6).Value = recset.FieldValue(5)
Wks.Cells(i, 7).Value = recset.FieldValue(6)
Wks.Cells(i, 8).Value = recset.FieldValue(7)
Wks.Cells(i, 9).Value = recset.FieldValue(8)
Wks.Cells(i, 10).Value = recset.FieldValue(9)
Wks.Cells(i, 11).Value = recset.FieldValue(10)
Wks.Cells(i, 12).Value = recset.FieldValue(11)
Wks.Cells(i, 13).Value = recset.FieldValue(12)
Wks.Cells(i, 14).Value = recset.FieldValue(13)
Wks.Cells(i, 15).Value = recset.FieldValue(14)
Dim r As Range
Wks.Cells(i, 8).NumberFormat = "@" 'set cells to text numberformat
Wks.Cells(i, 15).NumberFormat = "@"
With CreateObject("vbscript.regexp")
.Pattern = "<[^>]+>|;"
.Global = True
For Each r In Wks.Cells(i, 8)
r.Value = .Replace(r.Value, "")
Next r
For Each r In Wks.Cells(i, 15)
r.Value = .Replace(r.Value, "")
Next r
End With
Text = Wks.Cells(i, 8).Value
Wks.Cells(i, 8).Value = Replace(Text, " ", "")
Text = Wks.Cells(i, 8).Value
Wks.Cells(i, 8).Value = Replace(Text, """, "'")
Text = Wks.Cells(i, 15).Value
Wks.Cells(i, 15).Value = Replace(Text, " ", "")
Text = Wks.Cells(i, 15).Value
Wks.Cells(i, 15).Value = Replace(Text, "<v6ucbs>", "")
i = i + 1
recset.Next
Loop
Wkb.SaveAs "C:\Users\xxxx\Downloads\Files\Cancelled_Defects.xls"
End If
Wkb.Close
XLS.Quit
QCConnection.Disconnect
Set recset = Nothing
Set com = Nothing
Set QCConnection = Nothing
Set XLS = Nothing
Set Wkb = Nothing
Set Wks = Nothing
End Sub
Nessuna risposta ha la caratteristica desiderata? –