VBA VersionOne Code

VBA.bas

Option Explicit

'Constants
Const V1METAURL = "/meta.v1"
Const V1RESTHISTURL = "/rest-1.v1/Hist"
Const V1RESTDATAURL = "/rest-1.v1/Data"
Const V1OAUTHHISTURL = "/rest-1.oauth.v1/Hist"
Const V1OAUTHDATAURL = "/rest-1.oauth.v1/Data"
Const V1LOCURL = "/loc.v1"

Public Sub PopulateBacklog()

Dim projectScope As String
Dim sActiveProjects As String
Dim sSel As String
Dim nNextRow As Long
Dim nRow As Long

nRow = 7

'Clear data cell contents
Range("REPORT_AREA").ClearContents

'Get data from named ranges on the active sheet
projectScope = Range("projectScope").Value

If (projectScope = "") Then
    MsgBox "Please select and enter valid values.", vbExclamation
    Exit Sub
End If

'Update Select String to pull in more data
sSel = "Name,Number,Priority.Name,Estimate,OriginalEstimate,Parent.Name,Scope.Name,Timebox.Name,Status.Name,Team.Name,Risk.Name,Dependants,Order"
nNextRow = GetBacklog("Story", sSel, projectScope, nRow)
'For Defects
sSel = "Name,Number,Priority.Name,Estimate,Parent.Name,Scope.Name,Timebox.Name,Status.Name,Team.Name,Order"
nNextRow = GetBacklog("Defect", sSel, projectScope, nNextRow)

End Sub

'------------------
'Primary Subroutine to retrieve backlog based on Project Scope
'------------------
Private Function GetBacklog(assettype As String, selectcolumns As String, projectScopeName As String, startrow As Long)

Dim url As String
Dim xml As Object
Dim xmldoc As Object
Dim nRow As Long

nRow = startrow

'Retrieve Tasks
url = "/" & assettype & "?where=Scope.ParentMeAndUp.Name='" & projectScopeName & "';AssetState='64'&sel=" & selectcolumns

Set xmldoc = MakeRequest(url)
        
'Loop through returned values and add to active sheet
If xmldoc Is Nothing Then Exit Function

Dim assets As Object
Set assets = xmldoc.SelectNodes("Assets/Asset")
Dim i As Integer
For i = 0 To assets.Length - 1
    
    If assettype = "Story" Then
        'Can be more than one Dependant Story
        Dim dependants As String
        dependants = ""
        Dim dependant As Object
        Set dependant = assets(i).SelectNodes("Attribute[@name='Dependants.Number']/Value")
        Dim x As Integer
        For x = 0 To dependant.Length - 1
            If x = 0 Then
                dependants = dependant(x).Text
            Else
                dependants = dependants & ", " & dependant(x).Text
            End If
        Next x
        Range("E" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='OriginalEstimate']").Text
        Range("K" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Risk.Name']").Text
        Range("L" + CStr(nRow)).Value = dependants
    End If
    
    'Populate sheet
    Range("A" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Name']").Text
    Range("B" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Number']").Text
    Range("C" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Priority.Name']").Text
    Range("D" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Estimate']").Text
    Range("F" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Parent.Name']").Text
    Range("G" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Scope.Name']").Text
    Range("H" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Timebox.Name']").Text
    Range("I" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Status.Name']").Text
    Range("J" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Team.Name']").Text
    Range("M" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Order']").Text
    nRow = nRow + 1

Next i
Set assets = Nothing
Set xmldoc = Nothing
Set xml = Nothing

GetBacklog = nRow

End Function


'------------------
'Routine to retrieve stories that were split based on Project Scope
'------------------
Private Function GetSplitStories(assettype As String, selectcolumns As String, projectScopeName As String, startrow As Long)

Dim url As String
Dim xml As Object
Dim xmldoc As Object
Dim nRow As Long

nRow = startrow

'Retrieve Tasks
url = "/Story?sort=Order&where=Scope.ParentMeAndUp.Name='" & projectScopeName & "';AssetState='64','128'&sel=SplitToAndDown,Name,Number,Estimate,Parent.Name,Super.Name,Super.SuperAndUp.Name,Scope.Name,Timebox.Name,Status.Name,Team.Name,Dependants,ChangeDate"
Set xmldoc = MakeRequest(url)
        
'Loop through returned values and add to active sheet
Dim assets As Object
Set assets = xmldoc.SelectNodes("Assets/Asset")
Dim i As Integer
For i = 0 To assets.Length - 1
    
    If assettype = "Story" Then
        'Can be more than one Dependant Story
        Dim dependants As String
        dependants = ""
        Dim dependant As Object
        Set dependant = assets(i).SelectNodes("Attribute[@name='Dependants.Number']/Value")
        Dim x As Integer
        For x = 0 To dependant.Length - 1
            If x = 0 Then
                dependants = dependant(x).Text
            Else
                dependants = dependants & ", " & dependant(x).Text
            End If
        Next x
        Range("E" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='OriginalEstimate']").Text
        Range("K" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Risk.Name']").Text
        Range("L" + CStr(nRow)).Value = dependants
    End If
    
    'Populate sheet
    Range("A" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Name']").Text
    Range("B" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Number']").Text
    Range("C" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Priority.Name']").Text
    Range("D" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Estimate']").Text
    Range("F" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Parent.Name']").Text
    Range("G" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Scope.Name']").Text
    Range("H" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Timebox.Name']").Text
    Range("I" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Status.Name']").Text
    Range("J" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Team.Name']").Text
    Range("M" + CStr(nRow)).Value = assets(i).SelectSingleNode("Attribute[@name='Order']").Text
    nRow = nRow + 1

Next i
Set assets = Nothing
Set xmldoc = Nothing
Set xml = Nothing

GetSplitStories = nRow

End Function

Private Function MakeRequest(strUrl As String) As Object
    Dim strToken As String
    'Variables to make call
    Dim objHttp As MSXML2.ServerXMLHTTP60
    Dim lngStatusCode As Long
    Dim strStatusDescription As String
    Dim strFullUrl As String
    Dim strProxy As String
    'Initialize Variables
    'strProxy = Worksheets("config").Range("PROXY").Value
    strFullUrl = Worksheets("Config").Range("SERVER_BASE_URI").Value & V1RESTDATAURL & strUrl
    strToken = Worksheets("Config").Range("ACCESS_TOKEN").Value
    If Len(strToken) > 0 Then
        'Make call
        Set objHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
        objHttp.Open "GET", strFullUrl, False
        'If proxy is set, use the proxy
        If Len(strProxy) > 0 Then
            objHttp.setProxy 2, strProxy, ""
        End If
        objHttp.setRequestHeader "Authorization", "Bearer " & strToken
        objHttp.send
        lngStatusCode = objHttp.Status
        strStatusDescription = objHttp.statusText
        If lngStatusCode = 200 Then
            Set MakeRequest = objHttp.responseXML
        Else
            MsgBox CStr(lngStatusCode) & ": " & strStatusDescription, vbExclamation, "Server Response"
            Set MakeRequest = Nothing
        End If
    End If
    Set objHttp = Nothing
End Function