Monday 16 November 2015

Downloading all defects attachments from HP ALM in one go with OTA API VBscript

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

No comments:

Post a Comment