Udostępnij za pośrednictwem


Excel Macro to automatically refresh Team Foundation query bound work item lists

One of my favorite features in Beta 3 of Team Foundation is the return of "query bound" spreadsheets. I seem to spend a huge amount of time in Excel these days, using it as a tool to get a view on the current state of our bugs across each feature area and making sure that the teams are well load balanced.

Query Bound spreadsheets make this really easy. I can create a query in the IDE, save it in Team Explorer and then right click on it and choose "Open in Microsoft Excel" to create a sheet with a ist bound to that query. In Beta 2, once I created this list it was bound to the work items within the list - not to the query. Refreshing the list would just refresh the state of the work items, but not update the work items in the list to match the results of the query.

In Beta 3 this is different. I can choose to either bind my query to specific work items, or bind the list to a stored query - which is what I seem to use most frequently. I can then create pivot tables & charts across the results of the query to slice & dice the returned work items (perhaps a topic for another blog entry).

However, there is one thing that has been bugging me - since I often use several queries in one workbook, and use them to produced daily status mails, it becomes a real pain to keep refreshing the queries by clicking the button on the toolbar. Fortunately one of the devs on the team, Dennis Habib, has come up with a handy Excel macro does all of this for me - thanks Dennis! Here it is:

 Public Sub RefreshAllTeamFoundationListObjects()


    'Turn off updating the UI so we don't get a lot of flicker
    Application.ScreenUpdating = False

    'Make sure we turn screen updating back on if we get any errors
    On Error GoTo ErrorHandler
    
    'Save the current worksheet and selection range
    Dim curWs As Worksheet
    Set curWs = ThisWorkbook.ActiveSheet

    Dim curSel As Range
    Set curSel = Application.Selection

    'Iterate over all worksheets in the current workbook
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        If ws.ProtectContents Then
            MsgBox "Skipping protected worksheet " + ws.Name
        End If

        'Activate the worksheet or the selection change (below)
        'will not work
        ws.Activate

        'Iterate over all listobjects on the worksheet
        Dim list As ListObject

        For Each list In ws.ListObjects
            Call PerformRefresh(list)
        Next
    Next
    
    'Restore the originally selected worksheet and selected range
    curWs.Activate
    curSel.Select
    Application.ScreenUpdating = True

    GoTo Success

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "An error occurred while refreshing the Team Foundation lists"

Success:
    Application.StatusBar = "Finished refreshing Team Foundation Lists"

End Sub


Private Function PerformRefresh(list As ListObject)
    'See if this is a Team Foundation list.  Note:  'ELead' string may change to 'VSTS' in the final release!
    If Left(list.Name, 5) = "ELead" Then
        'Find the 'refresh' button.
        Dim refreshButton As CommandBarControl
        Set refreshButton = Application.CommandBars.FindControl(Tag:="IDC_REFRESH")

        'Save the current worksheet's selection
        Dim wsSel As Range
        Set wsSel = Application.Selection
        
        list.Range.Select

        'Seems that sometimes it takes a little while for the button
        'to become enabled.  I've never seen it take more than 2 seconds,
        'though on slower machines it may take longer...
        For i = 1 To 10
            If Not refreshButton.Enabled Then
                'Wait for the UI to settle down to ensure that the toolbar button has
                'had time to be enabled
                Application.Wait (Now + TimeValue("0:00:01"))
                DoEvents
            End If
        Next

        If refreshButton.Enabled Then
            refreshButton.Execute
        Else
            MsgBox "Refresh button not enabled!"
        End If
        
        'Restore the selection on the worksheet
        wsSel.Select
    End If

End Function

 

Comments