如何使Excel自動從TFS 2010工作項目查詢刷新

Question

我們使用Microsoft提供的默認提供的MSF Agile 5.0流程模板來運行我們的項目。具體來說，迭代積壓Excel表對於做項目管理非常有用。

但是，我們遇到了表單編號1上的迭代待辦事項不是最新的情況。打開Excel工作簿後，用戶必須明確地單擊「團隊」選項卡上的「刷新」按鈕以獲取最近的數據。

問題：我們如何強制Excel（2007）在打開工作簿時刷新迭代待辦事項並與它連接的TFS 2010工作項查詢同步？

其他人提供的用於記錄宏以單擊「刷新」按鈕的建議不起作用，因爲記錄的宏無法刷新具有樹層級結構的查詢（至少，執行宏時出錯會告訴我所以）。所錄製的宏做別的，只需點擊:-)

Answer 1

名單上的一些類型從MSDN庫引物
Types of lists
Converting a Input list to Query list

現在我們就看看問題在眼前。
正如前面的回答者所說，您需要從工作簿打開事件運行的代碼。我相信你已經知道的那部分。
refreshall方法是通用的，只適用於數據連接，公式和常規共享點列表。
您需要使用功能區中的團隊菜單。
以下代碼片段顯示瞭如何獲取表示保存工作項數據的表的列表對象的方法。
Synchronize TFS and Excel via VBA

如果鏈接斷開部分代碼複製（僅激活團隊菜單）。早在他們的文章在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 

Answer 2

據我所知按鈕，有其刷新所有XLS文件數據源的VB功能：ActiveWorkbook.RefreshAll

你只需要掛鉤它打開工作簿事件。

Answer 3

我想只要編輯匿名類型的答案，但我的編輯遭到拒絕這樣做新的答案。他錯過了RefreshTeamQuery方法中的部分代碼，如鏈接文章所示（here是更直接鏈接到原始代碼）。

我還有問題從工作簿打開事件調用這個問題，因爲我不認爲這些按鈕是在工具欄中創建的，或者在打開wookbook時以某種方式鏈接到工作表。使用按鈕上的代碼雖然工作正常。

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 

Answer 4

這個版本是相似的，但它有，你沒有的範圍內傳遞，而只是假設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