Add References Programatically

Over the last year I have had significant problems in distributing excel solutions as many users are updating computers and software. I never know what version of Microsoft office they are using, often they will use xp and office 2003 at work, but use vista and office 2007 at home or on their laptops. Suggestions of using late binding rather than early binding have been explored but I would prefer a solution that is unbreakable across all versions without too many user prompts.

I have searched discussions and examples about adding references from this and other forums: It is a little scarce on this topic but I have managed to put together a solution and some utilities to develop this further.
(a practical example is below which is probably not good code as its very long winded and repeative but I understand it and it is quite quick) What I ask members for is some advice on improving the code (it does work in most cases)

PS I am totally colour blind so please forgive the posting etiquete..

The following code is set up in a workbook open event. It checks to see if access to vba is enabled in trust settings then looks for VBA Extensibility. Then add reference to MS Office and to MS Word >>>

Private Sub Workbook_Open()
Dim Response As VbMsgBoxResult
'Test to ensure access is allowed
If Application.Version > 9 Then
Dim VisualBasicProject As Object
On Error Resume Next
Set VisualBasicProject = ActiveWorkbook.VBProject
If Not Err.Number = 0 Then
Response = MsgBox(" Programme Stop..Your current security settings do not allow the code in this workbook" & vbNewLine & _
" to work as designed and you will get some error messages." & vbNewLine & vbNewLine & _
"To allow the code to function correctly and without errors you need" & vbNewLine & _
" to change your security setting as follows:" & vbNewLine & vbNewLine & _
" 1. Select Tools - Macro - Security to show the security dialog" & vbNewLine & _
" 2. Click the 'Trusted Sources' tab" & vbNewLine & _
" 3. Place a checkmark next to 'Trust Access to Visual Basic Project'" & vbNewLine & _
" 4. Save - then Close and re-open the workbook" & vbNewLine & vbNewLine & _
"Click Yes to go directly to the security centre?", vbYesNoCancel + vbCritical)
If Response = vbYes Then Application.CommandBars("Macro").Controls("Security...").Execute
End If
End If
MsgBox "Security Settings valid, click OK to proceed"
Call DelER
Call AddReference
Call AddER
Application.AutomationSecurity = msoAutomationSecurityLow
Application.ScreenUpdating = False
Dim n
Dim Sh
n = ActiveSheet.Name
For Each Sh In ActiveWorkbook.Worksheets
Sh.Protect Password:= "******" UserInterfaceOnly:=True
Next Sh
Disclaimer.Show
Application.ScreenUpdating = True
Application.ThisWorkbook.Worksheets("Summary").Range("h19:i19").Value = ".xls"
Application.ThisWorkbook.Worksheets("Menu").Activate
Application.Calculate
Application.ScreenUpdating = True
End Sub

Private Sub AddReference()
Dim Reference As Object
With ThisWorkbook.VBProject
For Each Reference In .References
If Reference.Description Like "Microsoft Visual Basic for Applications Extensibility*" Then Exit Sub
Next
.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
End With
End Sub

Sub AddER()
Dim rVBReference
Dim wbBook As Workbook
Dim i As Integer
Dim theRef

Const stGuid11 As String = "{00020905-0000-0000-C000-000000000046}"
Const stName11 As String = "Microsoft Word 11.0 Object Library"
Const stoGuid11 As String = "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}"
Const stoName11 As String = "Microsoft Office 11.0 Object Library"
'version12
Const stGuid12 As String = "{00020905-0000-0000-C000-000000000046}"
Const stName12 As String = "Microsoft Word 12.0 Object Library"
Const stoGuid12 As String = "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}"
Const stoName12 As String = "Microsoft Office 12.0 Object Library"
Set wbBook = ThisWorkbook
'On Error GoTo Error_Handling
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set theRef = ThisWorkbook.VBProject.References.Item(i)
If theRef.IsBroken = True Then
ThisWorkbook.VBProject.References.Remove theRef
End If
Next i
If Application.Version = 12 Then GoTo v12settings
If Application.Version = 11 Then GoTo v11settings
'Iterate through the collection of active external references in the VB-project.
v12settings:
With wbBook
For Each rVBReference In Application.ThisWorkbook.VBProject.References
If rVBReference.GUID = stGuid12 Then
GoTo ExitHere
End If
Next rVBReference
End With
With wbBook
For Each rVBReference In Application.ThisWorkbook.VBProject.References
If rVBReference.GUID = stoGuid12 Then
GoTo ExitHere
End If
Next rVBReference
End With
With wbBook
'Create the external reference in the VB-project.
.VBProject.References.AddFromGuid stGuid12, 1, 0
.VBProject.References.AddFromGuid stoGuid12, 1, 0
End With
GoTo ExitHere
v11settings:
With wbBook
For Each rVBReference In Application.ThisWorkbook.VBProject.References
If rVBReference.GUID = stGuid11 Then
GoTo ExitHere
End If
Next rVBReference
End With
With wbBook
For Each rVBReference In Application.ThisWorkbook.VBProject.References
If rVBReference.GUID = stoGuid11 Then
GoTo ExitHere
End If
Next rVBReference
End With
With wbBook
'Create the external reference in the VB-project.
.VBProject.References.AddFromGuid stGuid11, 1, 0
.VBProject.References.AddFromGuid stoGuid11, 1, 0
End With
GoTo ExitHere
ExitHere:
Set rVBReference = Nothing
Exit Sub
Error_Handling:
MsgBox "Unable to create the reference as " & "Object Library" & vbCrLf & " is not available on this computer.Please contact technical support and state" & vbCrLf & " Missing Reference", vbCritical
Resume ExitHere
End Sub

Sub DelER()
Dim wbBook As Workbook
Const stDescription As String = "Word"
Const stDescription2 As String = "Office"
Set wbBook = ThisWorkbook
On Error GoTo Error_Handling
With wbBook.VBProject.References
'Delete the reference.
.Remove .Item(stDescription)
.Remove .Item(stDescription2)
End With
ExitHere:
Exit Sub
Error_Handling:
If stDescription = "" Then Exit Sub
MsgBox "The reference does not exist!", vbInformation
Resume ExitHere
End Sub

'Utilities
Function ListAllRefs()
Dim my_ref
For Each my_ref In ThisWorkbook.VBProject.References
With my_ref
Debug.Print .Name, .Description, .GUID, .FullPath, .IsBroken
Debug.Print
End With
Next
End Function

Sub Grab_References()
Application.DisplayAlerts = False

On Error Resume Next
Application.ThisWorkbook.Worksheets("GUIDS").Delete
Application.ThisWorkbook.Worksheets.Add.Name = "GUIDS"
Application.DisplayAlerts = True

Dim n As Integer
With ThisWorkbook.Worksheets("GUIDS")
On Error Resume Next

.Cells(1, 1) = "Name"
.Cells(1, 2) = "Description"
.Cells(1, 3) = "GUID"
.Cells(1, 4) = "Major"
.Cells(1, 5) = "Minor"
.Cells(1, 6) = "FullPath"
.Cells(1, 7) = "IsBroken"


For n = 2 To ActiveWorkbook.VBProject.References.Count
.Cells(n, 1) = ActiveWorkbook.VBProject.References.Item.Name
.Cells(n, 2) = ActiveWorkbook.VBProject.References.Item.Description
.Cells(n, 3) = ActiveWorkbook.VBProject.References.Item.GUID
.Cells(n, 4) = ActiveWorkbook.VBProject.References.Item.Major
.Cells(n, 5) = ActiveWorkbook.VBProject.References.Item.Minor
.Cells(n, 6) = ActiveWorkbook.VBProject.References.Item.FullPath
.Cells(n, 7) = ActiveWorkbook.VBProject.References.Item .IsBroken
Next n
End With