Project reference-fixing macros for Visual Studio

ProjectMacros.vb

' These macros can be used to automatically swap between project and file references when adding/removing projects from a solution.
'  When adding a new project to a solution, all the existing projects (and the new project) are scanned to see if there
'  are existing file references to the project. If so, the file reference will be updated to a project reference.
' Conversely, when removing a project, if the macro can file a dll on the references path which has the same name as the removed
'  project, it will change the project reference to a file reference.
' There are a few idiosyncrasies to be aware of: in my environment, all projects build to a common folder, so the macro will set references
'  to 'No Copy', 'Any version', EXCEPT for 'Test' projects
' (Note that not all project types are supported)
' This code won't update a project when it is removed (impossible to save a project when it's already 'gone')

' Adding the code below to the builtin EnviromentEvents module will invoke these macros automatically when projects are removed or added.
' Note that you can also manually invoke the 'RepairReferences' macro.
' Note also that unfortunately this stuff is synchronous, so on very large solutions you have to wait a while to see anything happening...
'  In particular, the RepairReferences macro will probably provoke the 'Delay Notification' warning - but you should be able to see
'  progress in the Output window.
' IMPORTANT: You will have to add some Project References to your macros project to get this working. Unfortunately my project has 
'  accumulated extraneous references with time, so not all of these will be appropriate: EnvDTE, EnvDTE80, EnvDTE90, Microsoft.Vsa, 
'  VSLangProj, VSLangProj2, VSLangProj80, VsMacroHierarchyLib
' ==== BEGIN: To be added to Environment events

    Const ProjectKindSetup As String = "{54435603-DBB4-11D2-8724-00A0C9A8B90C}"

    Private Sub SolutionEvents_ProjectAdded(ByVal Project As EnvDTE.Project) Handles SolutionEvents.ProjectAdded
        If Project.Kind <> EnvDTE.Constants.vsProjectKindMisc And Project.Kind <> ProjectKindSetup Then
            Call HandleAddProject(Project)
        End If
    End Sub

    Private Sub SolutionEvents_ProjectRemoved(ByVal Project As EnvDTE.Project) Handles SolutionEvents.ProjectRemoved
        If Project.Kind <> EnvDTE.Constants.vsProjectKindMisc And Project.Kind <> ProjectKindSetup Then
            Call HandleRemoveProject(Project)
        End If
    End Sub
' ==== END: To be added to Environment events

' ==== BEGIN: ProjectMacros.vb
Imports System
Imports EnvDTE
Imports EnvDTE80
Imports System.Diagnostics
Imports System.Web
Imports System.Collections.Generic

Public Module BenMacros
    Private K_PROJECT_GUID As String = "{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}"
    Private K_SOLUTION_FOLDER_GUID As String = "{66A26720-8FB5-11D2-AA7E-00C04F688DDE}"

    '-----------------------------------------------------------------------------
    'Called on add project - cycle through other projects, replace references if found
    Sub HandleAddProject(ByVal Project As EnvDTE.Project)
        On Error GoTo ErrHandle

        Dim proj As EnvDTE.Project
        Dim projAsLangProj As VSLangProj.VSProject
        Dim refItem As VSLangProj.Reference

        If Project.Kind <> K_PROJECT_GUID Then Exit Sub

        Call WriteToOutputWindow("---- Handle file references on adding " & Project.Name & " ----")

        For Each proj In GetSolutionProjects()
            'check for new project in the existing projects' references
            If proj.Kind <> K_PROJECT_GUID Then Continue For
            If Not proj.Object Is Nothing And Not proj Is Project Then
                projAsLangProj = proj.Object
                For Each refItem In projAsLangProj.References
                    If refItem.Name = Project.Name Then
                        Call ChangeFileRefToProjRef(refItem, Project, proj)
                        Exit For ' go to next project
                    End If
                Next
            End If
        Next

        'Attempt repair of new project references (change from proj to file references if broken)
        Call RestoreAvailableProjectRefs(Project)
        Call RepairBrokenProjectRefs(Project)

        Exit Sub
ErrHandle:
        Call MsgBox("Error: " & Err.Description)
    End Sub

    'Called on remove project - attempt to replace project reference with file reference, using project reference paths
    Sub HandleRemoveProject(ByVal Project As EnvDTE.Project)
        On Error GoTo ErrHandle

        Dim proj As EnvDTE.Project
        Dim projAsLangProj As VSLangProj.VSProject
        Dim refItem As VSLangProj.Reference

        If Project.Kind <> K_PROJECT_GUID Then Exit Sub

        Call WriteToOutputWindow("---- Handle project references before removing " & Project.Name & " ----")

        'Check all other projects in solution
        For Each proj In GetSolutionProjects()
            If proj.Kind <> K_PROJECT_GUID Then Continue For
            If Not proj.Object Is Nothing And Not proj Is Project Then
                projAsLangProj = proj.Object

                'Check all the refences in the project
                For Each refItem In projAsLangProj.References
                    ' If references the project we are removing
                    If refItem.Name = Project.Name Then
                        Call ChangeProjRefToFileRef(refItem, proj)
                        Exit For ' goto next project
                    End If
                Next ' reference
            End If
        Next 'project

        'Check all references for project we are removing - remove any project references
        ' HACK: Apparently this doesn't work..? no way to save changes before leaving, Project.Save throws error
        projAsLangProj = Project.Object
        For Each refItem In projAsLangProj.References
            If Not refItem.SourceProject Is Nothing Then
                Call ChangeProjRefToFileRef(refItem, Project)
            End If
        Next

        'New - need to save changes to project?
        'Call Project.Save()

        Exit Sub

ErrHandle:
        Call MsgBox("Error in ChangeProjRefToFileRef(" & Project.Name & "): " & Err.Description)
    End Sub

    ' Remove reference to ReferencedProjectName from references,
    '   Attempt to locate corresponding dll in referencePath of ReferencingProject
    '   If found, add to references
    Sub ChangeProjRefToFileRef(ByRef refItem As VSLangProj.Reference, ByRef ReferencingProject As EnvDTE.Project)
        On Error GoTo ErrHandle

        If ReferencingProject.Kind <> K_PROJECT_GUID Then Exit Sub

        Dim projAsLangProj As VSLangProj.VSProject
        Dim ReferencedProjectName As String
        Dim arrRefPath() As String
        Dim i As Integer
        Dim fileRefPath As String
        Dim newRef As VSLangProj.Reference

        ' Get project name form reference (just for readability)
        ReferencedProjectName = refItem.Name

        ' On Error Resume Next
        'Split reference path (can be multiple, or potentially also empty)
        arrRefPath = Microsoft.VisualBasic.Strings.Split(ReferencingProject.Properties.Item("ReferencePath").Value, ";")

        projAsLangProj = ReferencingProject.Object
        For i = 0 To UBound(arrRefPath)
            fileRefPath = arrRefPath(i) & ReferencedProjectName & ".dll"
            If System.IO.File.Exists(fileRefPath) Then
                Call refItem.Remove() 'only remove it if we can find a replacement.
                newRef = projAsLangProj.References.Add(fileRefPath)
                newRef.SpecificVersion = False ' not a specific version
                'set to not copy local unless test project
                If InStr(LCase(ReferencingProject.Name), "test") = 0 Then
                    newRef.CopyLocal = False
                End If
                Call WriteToOutputWindow("Changed project reference to file reference for " & ReferencedProjectName & " in project " & ReferencingProject.Name)
                Exit Sub ' nothing more to look for
            End If
        Next

        Call WriteToOutputWindow("No file available on disk to replace reference to " & ReferencedProjectName & " in project " & ReferencingProject.Name)
        Exit Sub

ErrHandle:
        Call WriteToOutputWindow("Error in ChangeProjRefToFileRef(" + refItem.Name + ", " + ReferencingProject.Name + ") : " + Err.Description)
        Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
    End Sub

    'For given project, check all references. If broken project references found, attempt to transform to file references
    Sub ChangeFileRefToProjRef(ByRef refItem As VSLangProj.Reference, ByRef ReferencedProject As EnvDTE.Project, _
                              ByVal ReferencingProject As EnvDTE.Project)
        On Error GoTo ErrHandle

        Dim projAsLangProj As VSLangProj.VSProject
        Dim newRef As VSLangProj.Reference

        If ReferencingProject.Kind <> K_PROJECT_GUID Then Exit Sub

        refItem.Remove()
        projAsLangProj = ReferencingProject.Object
        newRef = projAsLangProj.References.AddProject(ReferencedProject)
        If ReferencingProject.Name.Contains("Test") Then
            newRef.CopyLocal = True
        Else
            newRef.CopyLocal = False
        End If
        newRef.SpecificVersion = False
        Call WriteToOutputWindow("Changed file reference to project reference for " & ReferencedProject.Name & " in project " & ReferencingProject.Name)

        Exit Sub

ErrHandle:
        Call WriteToOutputWindow("Error in ChangeFileRefToProjRef(" + refItem.Name + ", " + ReferencedProject.Name + ", " + ReferencingProject.Name + ") : " + Err.Description)
        Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
    End Sub

    Public Sub WriteToOutputWindow(ByVal Msg As String)
        Dim owPane As OutputWindowPane

        Dim win As Window = DTE.Windows.Item(EnvDTE.Constants.vsWindowKindOutput)
        Dim ow As OutputWindow = win.Object
        Try
            owPane = ow.OutputWindowPanes.Item("General")
        Catch
            owPane = ow.OutputWindowPanes.Add("General")
        End Try
        If Not owPane Is Nothing Then
            owPane.Activate()
            owPane.OutputString(Msg & vbCrLf)
        End If
    End Sub


    'For given project, check all references. If broken project references found, attempt to transform to file references
    Sub RepairBrokenProjectRefs(ByVal ReferencingProject As EnvDTE.Project)
        On Error GoTo ErrHandle

        Dim projAsLangProj As VSLangProj.VSProject
        Dim refItem As VSLangProj.Reference

        If ReferencingProject.Kind <> K_PROJECT_GUID Then Exit Sub

        projAsLangProj = ReferencingProject.Object
        For Each refItem In projAsLangProj.References
            ' If path is empty, this reference is broken, we can try to find it in reference path
            If refItem.Path = "" Then
                Call ChangeProjRefToFileRef(refItem, ReferencingProject)
            End If
        Next ' reference
        Exit Sub

ErrHandle:
        Call WriteToOutputWindow("Error in RepairBrokenProjectRefs(" + ReferencingProject.Name + ") : " + Err.Description)
        Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

    End Sub

    'For given project, check all references. If broken project references found, attempt to transform to file references
    Sub RestoreAvailableProjectRefs(ByVal ReferencingProject As EnvDTE.Project)
        On Error GoTo ErrHandle

        Dim projAsLangProj As VSLangProj.VSProject
        Dim refItem As VSLangProj.Reference

        If ReferencingProject.Kind <> K_PROJECT_GUID Then Exit Sub

        projAsLangProj = ReferencingProject.Object
        For Each refItem In projAsLangProj.References
            For Each ReferencedProject In GetSolutionProjects()
                'Check for existing project in new project's references
                If ReferencedProject.Name = refItem.Name And refItem.SourceProject Is Nothing Then
                    ChangeFileRefToProjRef(refItem, ReferencedProject, ReferencingProject)
                    Exit For ' goto next proj
                End If
            Next
        Next ' reference
        Exit Sub

ErrHandle:
        Call WriteToOutputWindow("Error in RestoreAvailableProjectRefs(" + ReferencingProject.Name + ") : " + Err.Description)
        Err.Raise(Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

    End Sub

    'List projects in solution, and in solution folders
    Private Function GetSolutionProjects() As List(Of EnvDTE.Project)
        On Error GoTo ErrHandle

        Dim proj As EnvDTE.Project
        Dim projitem As EnvDTE.ProjectItem
        GetSolutionProjects = New List(Of EnvDTE.Project)

        For Each proj In DTE.Solution.Projects
            If proj.Kind = K_PROJECT_GUID Then
                GetSolutionProjects.Add(proj)
            ElseIf proj.Kind = K_SOLUTION_FOLDER_GUID Then
                For Each projitem In proj.ProjectItems
                    If projitem.SubProject.Kind = K_PROJECT_GUID Then
                        GetSolutionProjects.Add(projitem.SubProject)
                    End If
                Next
            End If
        Next

        Exit Function
ErrHandle:
        Call MsgBox("Error: " & Err.Description)
    End Function

    'For debugging purposes: so we can work out the guid of any problematic project types
    Public Sub ListProjectTypes()

        For Each proj In DTE.Solution.Projects
            WriteToOutputWindow(proj.Name + "(" + proj.Kind + ")")
            If proj.Kind = K_SOLUTION_FOLDER_GUID Then
                For Each projitem In proj.ProjectItems
                    WriteToOutputWindow(projitem.Name + "(" + projitem.Kind + ")")
                Next
            End If
        Next
    End Sub

    'Macro to test if references are pointing to a bad folder
    Public Sub RepairReferences()
        On Error GoTo ErrHandle

        Dim proj As EnvDTE.Project
        Dim projects As List(Of EnvDTE.Project) = GetSolutionProjects()
        Dim i As Integer = projects.Count
        For Each proj In GetSolutionProjects()
            WriteToOutputWindow(i.ToString() + ". Checking " + proj.Name)
            Call System.Windows.Forms.Application.DoEvents()
            Call RepairBrokenProjectRefs(proj)
            Call RestoreAvailableProjectRefs(proj)
            Call proj.Save() 'just in case
            i = i - 1 'count down, so we know how long we have to wait
        Next
        Call MsgBox("Done repairing references!")

        Exit Sub
ErrHandle:
        Call MsgBox("Error: " & Err.Description)
    End Sub

    'Macro to set all project references to no copy, any version (assuming all projects build to a common folder)
    Public Sub SetAllRefsToNoCopyAnyVersion()
        On Error GoTo ErrHandle

        Dim proj As EnvDTE.Project
        Dim project As VSLangProj.VSProject
        Dim refItem As VSLangProj.Reference

        Dim projects As List(Of EnvDTE.Project) = GetSolutionProjects()
        Dim i As Integer = projects.Count

        For Each proj In projects
            project = proj.Object
            WriteToOutputWindow(i.ToString() + ". Checking " + proj.Name)
            i = i - 1 'count down, so we know how long we have to wait
            For Each refItem In project.References
                If Not refItem.Name.StartsWith("System") Then
                    On Error Resume Next ' can't work out how to detect if it is an auto-reference
                    'Note that CopyLocal is actually tri-state, VS only saves value if you change it :(
                    If proj.Name.Contains("Test") Then
                        refItem.CopyLocal = True
                        refItem.CopyLocal = False
                        refItem.CopyLocal = True
                    Else
                        refItem.CopyLocal = False
                        refItem.CopyLocal = True
                        refItem.CopyLocal = False
                    End If
                    refItem.SpecificVersion = False
                    On Error GoTo ErrHandle
                End If
            Next  ' reference
            Call proj.Save()
        Next 'project

        Exit Sub
ErrHandle:
        Call MsgBox("Error: " & Err.Description)
    End Sub
End Module
' ==== END: ProjectMacros.vb