如何让Excel自动从TFS 2010工作项查询中刷新数据

Question

我们正在使用微软提供的默认 MSF Agile 5.0 流程模板来运行我们的项目。具体而言，迭代待办事项 Excel 表格对于进行项目管理非常有用。

然而，我们遇到了这样的情况：第一个表格上的迭代待办事项没有及时更新。打开 Excel 工作簿后，用户必须明确地点击团队选项卡上的刷新按钮才能查看最新数据。

问题是：我们如何强制 Excel（2007）在打开工作簿时刷新迭代待办事项并与其连接的 TFS 2010 工作项查询进行同步？

其他人提供的记录单击刷新按钮的宏建议无法解决这个问题，因为记录的宏无法刷新具有树形层次结构的查询（至少，在执行宏时会出现错误提示）。记录的宏做了一些与单击按钮不同的操作 :-)

- kroonwijk

Answer 1

MSDN图书馆中有一些关于列表类型的入门级文献
列表类型
将输入列表转换为查询列表

现在来看看问题的关键。
如前面的回答者所说，你需要编写从工作簿打开事件运行的代码。我相信这部分你已经知道了。
Refreshall方法是通用的，仅适用于数据连接、公式和常规SharePoint列表。
你需要使用功能区中的“团队”菜单。
下面的代码片段展示了如何操作，以及获取表示持有工作项数据的表格的列表对象的方法。
通过VBA同步TFS和Excel

如果链接断开，代码的部分内容如下（只激活“团队”菜单）。他们文章中的MSDN链接似乎已经失效了（或许没有..）

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

- Anonymous Type

---

这绝对是正确的答案。运行得非常好！谢谢匿名类型。 - kroonwijk

RefreshTeamQuery 方法中缺少一部分代码。我尝试编辑答案，但被拒绝了，所以在下面新建了一个完整的代码答案。 - Warren Parks

Answer 2

我试图编辑匿名类型的答案，但我的编辑被拒绝了，所以我写了一个新答案。他错过了RefreshTeamQuery方法的代码部分，如链接文章所示（here是原始代码的更直接链接）。

我仍然无法从工作簿打开事件中调用它，因为我不认为这些按钮在工具栏中创建或与工作表链接，当工作簿打开时。使用按钮上的代码可以正常工作。

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

- Warren Parks

Answer 3

这个版本类似，但它有一个选项，您不必传递范围，而是假设用户已经点击（选择）了TFS表。

原始功能也在那里：

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

- zumalifeguard

Answer 4

据我所知，有一个VB函数可以刷新所有xls文件的数据源：ActiveWorkbook.RefreshAll 你只需要将它连接到打开工作簿事件即可。

- LevaR

---

我刚试了一下。但它不能刷新或更新我的TFS工作列表项。我认为在Excel和TFS之间的集成处理中有一些特殊的处理。这不仅仅是一个普通的数据连接或外部数据源，我想。 - kroonwijk

打开工作簿事件解决了第一部分，RefreshAll 方法无法满足第二个要求。 - Anonymous Type

根据我的经验，RefreshAll 对我来说从未奏效，至少对于 Access 2003 是如此。我总是遍历所有可刷新的内容并执行标准的 Refresh 操作。 - PowerUser