Below code downloads an attachments of defect in HP ALM
Set udv_tdc = CreateObject("TDApiOle80.TDConnection")
udv_tdc.InitConnectionEx "https://<QCServer>/qcbin"
udv_tdc.Login "ABCD", "XXX"
If Err.Number <> 0 Then
lblMessage.Caption = ("Error: ") & Err.Description
'MsgBox "Error occurred with description: "& Err.Description
'Exit Sub
End If
''Making enable of available domains
udv_tdc.Connect "Domain", "Project"
If udv_tdc.Connected = True Then
'lblMessage.Caption = "User Authenticated successfully. !!"
'MsgBox "User Authenticated successfully. !!"
Else
'lblMessage.Caption = "User Authentication is Failed. Please check you access to HP ALM. !!!"
'MsgBox "User Authentication is Failed. Please check you access to HP ALM. !!!"
End If
Set BugCollection = udv_tdc.BugFactory.Filter
BugCollection.Filter("BG_BUG_ID") = "1234" ' filtering with bug ID, comment/change it based on your requirment
Set BugList = BugCollection.NewList
bugnum = BugList.count
'print QCConnection.DomainName
'MsgBox "Working on :=> " & bugnum & " Defects"
For Each Bug in BugList
Set attachFact = Bug.Attachments
Set attachList = attachFact.NewList("")
AttachmentCount = attachList.count
'MsgBox "Start Bug ID:=> "& bug.ID &" Total Number of Attachments :=> " & AttachmentCount
For each FileAttch in attachList
zeroName = FileAttch.Name(0)
oneName = FileAttch.Name(1)
'MsgBox "0: " & zeroName & " 1: " & oneName
FileAttch.Load True,"C:\Govardhan\Temp\ALM\Atmts"
Set ExStrg = FileAttch.AttachmentStorage
'ExStrg.ClientPath = "E:\Govardhan\"& QCConnection.ProjectName&"\"&Bug.ID
ExStrg.ClientPath = "C:\Govardhan\Temp\ALM\Atmts"
ExStrg.Load FileAttch.Name, True
Next
'MsgBox "End Bug ID:=> "& bug.ID &" Total Number of Attachments :=> " & AttachmentCount
Next
Set BugCollection = Nothing
Set BugList = Nothing
Set attachFact = Nothing
Set attachList = Nothing
Set ExStrg = Nothing
Set udv_tdc = Nothing
udv_tdc.InitConnectionEx "https://<QCServer>/qcbin"
udv_tdc.Login "ABCD", "XXX"
If Err.Number <> 0 Then
lblMessage.Caption = ("Error: ") & Err.Description
'MsgBox "Error occurred with description: "& Err.Description
'Exit Sub
End If
''Making enable of available domains
udv_tdc.Connect "Domain", "Project"
If udv_tdc.Connected = True Then
'lblMessage.Caption = "User Authenticated successfully. !!"
'MsgBox "User Authenticated successfully. !!"
Else
'lblMessage.Caption = "User Authentication is Failed. Please check you access to HP ALM. !!!"
'MsgBox "User Authentication is Failed. Please check you access to HP ALM. !!!"
End If
Set BugCollection = udv_tdc.BugFactory.Filter
BugCollection.Filter("BG_BUG_ID") = "1234" ' filtering with bug ID, comment/change it based on your requirment
Set BugList = BugCollection.NewList
bugnum = BugList.count
'print QCConnection.DomainName
'MsgBox "Working on :=> " & bugnum & " Defects"
For Each Bug in BugList
Set attachFact = Bug.Attachments
Set attachList = attachFact.NewList("")
AttachmentCount = attachList.count
'MsgBox "Start Bug ID:=> "& bug.ID &" Total Number of Attachments :=> " & AttachmentCount
For each FileAttch in attachList
zeroName = FileAttch.Name(0)
oneName = FileAttch.Name(1)
'MsgBox "0: " & zeroName & " 1: " & oneName
FileAttch.Load True,"C:\Govardhan\Temp\ALM\Atmts"
Set ExStrg = FileAttch.AttachmentStorage
'ExStrg.ClientPath = "E:\Govardhan\"& QCConnection.ProjectName&"\"&Bug.ID
ExStrg.ClientPath = "C:\Govardhan\Temp\ALM\Atmts"
ExStrg.Load FileAttch.Name, True
Next
'MsgBox "End Bug ID:=> "& bug.ID &" Total Number of Attachments :=> " & AttachmentCount
Next
Set BugCollection = Nothing
Set BugList = Nothing
Set attachFact = Nothing
Set attachList = Nothing
Set ExStrg = Nothing
Set udv_tdc = Nothing
No comments:
Post a Comment