मैं एक कोड है जो एक एक्सेल में एएलएम 12.53 और निर्यात दोष या किसी अन्य रिपोर्ट से कनेक्ट करेगा लिखा। आपको एक्सेल 2013 में टूल => संदर्भ..ओटीए कॉम टाइप लाइब्रेरी चेक की आवश्यकता है। मुझे HTML कोड के साथ समस्या थी इसलिए मैंने एक्सेल फ़ील्ड से HTML टैग को निकालने के लिए नीचे दी गई कुछ पंक्तियां जोड़ दी हैं।
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
कोई जवाब नहीं वांछित सुविधा है? –