开发者

How to make Excel automatically refresh from TFS 2010 workitem query

开发者 https://www.devze.com 2023-04-04 21:15 出处:网络
We are using the default provided MSF Agile 5.0 process template from Microsoft for running our projects. Specifically, the Iteration Backlog Excel sheet is very useful for doing project management.

We are using the default provided MSF Agile 5.0 process template from Microsoft for running our projects. Specifically, the Iteration Backlog Excel sheet is very useful for doing project management.

We have however run into situations that the Iteration Backlog on sheet number 1 was not up-to-date. After opening the Excel workbook, the user has to explicitly click the Refresh button on the Team tab to get the most recent data into view.

Question: how can 开发者_高级运维we force Excel (2007) to refresh the Iteration Backlog on opening the Workbook and synchronize with the TFS 2010 workitem query it is connected to?

The suggestion provided by others to record a Macro for clicking the Refresh button does not work, because the recorded macro is not capable of refreshing a query with a tree hierachy (at least, an error occurs executing the Macro telling me so). The recorded macro does something else that just clicking the button :-)


Some primers from MSDN library on list types
Types of lists
Converting a Input list to Query list

Now on to the issue at hand.
As the previous answerer said you need code that runs from the workbook open event. I believe that part you already knew.
The refreshall method is generic and only works for data connections, formulas and regular sharepoint lists.
You need to use the Team menu from the ribbon.
The following code snippet shows how, plus the method by which to grab the list object that represents the table holding the workitem data.
Synchronize TFS and Excel via VBA

In case the link breaks partial reproduction of code follows (just activation of Team menu). Already the MSDN link in their article looks broken (or maybe not..)

Private Function FindTeamControl(tagName As String) As CommandBarControl
    Dim commandBar As commandBar
    Dim teamCommandBar As commandBar
    Dim control As CommandBarControl

    For Each commandBar In Application.CommandBars
        If commandBar.Name = "Team" Then
            Set teamCommandBar = commandBar
            Exit For
        End If
    Next

    If Not teamCommandBar Is Nothing Then
        For Each control In teamCommandBar.Controls
            If InStr(1, control.Tag, tagName) Then
                Set FindTeamControl = control
                Exit Function
            End If
        Next
    End If

End Function
Sub RefreshTeamQuery(shtTFSExcel_Name As String) '(rangeName As String)

    Dim activeSheet As Worksheet
    Dim teamQueryRange As Range
    Dim refreshControl As CommandBarControl

    Set refreshControl = FindTeamControl("IDC_REFRESH")

    If refreshControl Is Nothing Then
        MsgBox "Could not find Team Foundation commands in Ribbon. Please make sure that the Team Foundation Excel plugin is installed.", vbCritical
        Exit Sub
    End If
End Sub


I tried to just edit Anonymous Type's answer but my edit was rejected so making new answer. He was missing part of the code from the RefreshTeamQuery method as shown in linked article(here is a more direct link to original code).

I'm also still having issues calling this from the workbook open event because I don't think those buttons are created in toolbar or somehow linked to worksheet when the wookbook is opened. Using code on a button works fine though.

Private Function FindTeamControl(tagName As String) As CommandBarControl
    Dim commandBar As commandBar
    Dim teamCommandBar As commandBar
    Dim control As CommandBarControl

    For Each commandBar In Application.CommandBars
        If commandBar.Name = "Team" Then
            Set teamCommandBar = commandBar
            Exit For
        End If
    Next

    If Not teamCommandBar Is Nothing Then
        For Each control In teamCommandBar.Controls
            If InStr(1, control.Tag, tagName) Then
                Set FindTeamControl = control
                Exit Function
            End If
        Next
    End If

End Function
Sub RefreshTeamQuery(shtTFSExcel_Name As String) '(rangeName As String)

    Dim activeSheet As Worksheet
    Dim teamQueryRange As Range
    Dim refreshControl As CommandBarControl

    Set refreshControl = FindTeamControl("IDC_REFRESH")

    If refreshControl Is Nothing Then
        MsgBox "Could not find Team Foundation commands in Ribbon. Please make sure that the Team Foundation Excel plugin is installed.", vbCritical
        Exit Sub
    End If 

    'Disable screen updating temporarily so that the user doesn’t see us selecting a range
    Application.ScreenUpdating = False

    'Capture the currently active sheet, we will need it later
    Set activeSheet = ActiveWorkbook.activeSheet
    Set teamQueryRange = Worksheets(shtTFSExcel_Name).ListObjects(1).Range

    teamQueryRange.Worksheet.Select
    teamQueryRange.Select
    refreshControl.Execute

    activeSheet.Select

    Application.ScreenUpdating = True
End Sub


This version is similar, but it has the option where you don't have to pass in a range, but simply assume the TFS table has been clicked on (selected) by the user.

The original functionality is also there:

Sub RefreshTeamQuery()
    Dim sel As Range: Set sel = Application.Selection: If sel Is Nothing Then Exit Sub
    Dim lo As ListObject: Set lo = sel.ListObject: If lo Is Nothing Then Exit Sub
    RefreshTeamQueryWithList lo
End Sub

Sub RefreshTeamQueryWithList(lo As ListObject)

    Dim activeSheet As Worksheet
    Dim teamQueryRange As Range
    Dim refreshControl As CommandBarControl

    Set refreshControl = FindTeamControl("IDC_REFRESH")

    If refreshControl Is Nothing Then
        MsgBox "Could not find Team Foundation commands in Ribbon. Please make sure that the Team Foundation Excel plugin is installed.", vbCritical
        Exit Sub
    End If

    On Error GoTo errorHandler

    'Disable screen updating temporarily so that the user doesn’t see us selecting a range
    Application.ScreenUpdating = False

    'Capture the currently active sheet, we will need it later
    Set activeSheet = ActiveWorkbook.activeSheet
    Set teamQueryRange = lo.Range

    teamQueryRange.Worksheet.Select
    teamQueryRange.Select
    refreshControl.Execute

    activeSheet.Select
    Application.ScreenUpdating = True

errorHandler:
    If Not activeSheet Is Nothing Then activeSheet.Select
    Application.ScreenUpdating = True
End Sub

Private Function FindTeamControl(tagName As String) As CommandBarControl
    Dim commandBar As commandBar
    Dim teamCommandBar As commandBar
    Dim control As CommandBarControl

    For Each commandBar In Application.CommandBars
        If commandBar.Name = "Team" Then
            Set teamCommandBar = commandBar
            Exit For
        End If
    Next

    If Not teamCommandBar Is Nothing Then
        For Each control In teamCommandBar.Controls
            If InStr(1, control.Tag, tagName) Then
                Set FindTeamControl = control
                Exit Function
            End If
        Next
    End If

End Function


As I know, there is an VB function which refreshes all xls-file data sources: ActiveWorkbook.RefreshAll

You only need to hook it up to open workbook event.

0

精彩评论

暂无评论...
验证码 换一张
取 消