I recently needed to do something similar, but was unable to find the code to
find the references until I stumbled upon the following from Ken Puls. I
modified the code to suit my needs and formatting.
Add the ListReferencePaths subroutine to your project. Run it, and discover
the precise Reference you're needing to set in the project your distribute.
Add the AddReference procedure with the proper reference(s) in it, and call
it from your WorkBook Open event. I've not tested this yet, nor do I know
how your password protection will effect it, but this should get you going in
the right direction.
Mark Trevithick
'---------------------------------------------------------------------------------------
' Procedure : AddReference
' Author : Ken Pulls
http://www.vbaexpress.com/kb/getarticle.php?kb_id=267
' Date : 20091109
' Purpose : AddReferenc
'---------------------------------------------------------------------------------------
'
Sub AddReference()
'Macro purpose: To add a reference to the project using the GUID for the
'reference library
Dim strGUID As String, theRef As Variant, i As Long
'Update the GUID you need below.
strGUID = "{00020905-0000-0000-C000-000000000046}"
'Set to continue in case of error
On Error Resume Next
'Remove any missing references
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
'Clear any errors so that error trapping for GUID additions can be evaluated
Err.Clear
'Add the reference
ThisWorkbook.VBProject.References.AddFromGuid _
guid:=strGUID, Major:=1, Minor:=0
'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please
check the " _
& "references in your VBA project!", vbCritical + vbOKOnly,
"Error!"
End Select
On Error GoTo 0
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ListReferencePaths
' Author : Ken Puls
http://www.vbaexpress.com/kb/getarticle.php?kb_id=267
' Date : 20091109
' Purpose : ListReferencePath
'---------------------------------------------------------------------------------------
'
Sub ListReferencePaths()
'Macro purpose: To determine full path and Globally Unique Identifier
(GUID)
'to each referenced library. Select the reference in the Tools\References
'window, then run this code to get the information on the reference's
library
On Error Resume Next
Dim i As Long
Dim ws As Worksheet
Worksheets.Add
Set ws = ActiveSheet
With ws
'.Select
'Copy the Index sheet to to end of sheets
.Move After:=Worksheets(Worksheets.Count)
.Name = "References"
'End With
With .Tab
.Color = 10498160
.TintAndShade = 0
End With
.Cells.Clear
'I chose Row 8 because I have a dynamic hyperlink that is created in Row 7
.Range("A2") = "Number"
.Range("B2") = "Reference Name"
.Range("C2") = "Full path to Reference"
.Range("D2") = "Reference GUID"
End With
For i = 1 To ThisWorkbook.VBProject.References.Count
With ThisWorkbook.VBProject.References(i)
ThisWorkbook.Sheets("References").Range("A65536").End(xlUp).Offset(1,
0) = i
ThisWorkbook.Sheets("References").Range("A65536").End(xlUp).Offset(0,
1) = .Name
ThisWorkbook.Sheets("References").Range("A65536").End(xlUp).Offset(0,
2) = .FullPath
ThisWorkbook.Sheets("References").Range("A65536").End(xlUp).Offset(0,
3) = .guid & ", " & .Major & ", " & .Minor
End With
Next i
'Format the data
Range("A2
2").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
With .borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
End With
Columns("A:A").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
Cells.EntireColumn.AutoFit
End With
Cells(1, 1).Select
On Error GoTo 0
End Sub
