How to change the default vba references in excel

2020-03-05 02:34发布

I want to add a vba function to personal.xlsb, but this function has an ADODB.Connection object in it.

I can resolve that by (in the VBA editor) selecting tools -> references and then checking the box "Microsoft ActiveX Data Objects 6.0 Library"

My question is, how do I make "Microsoft ActiveX Data Objects 6.0 Library" one of my default references so that it is always available whenever I start up excel?

2条回答
祖国的老花朵
2楼-- · 2020-03-05 02:52

Here is an alternate method. Could be added as a button or an on open command. Not too clean but gets the job done with minimal code:

Sub AddReference()

On Error GoTo ErrHandler:

'VBA
References.AddFromGuid "{000204EF-0000-0000-C000-000000000046}", 0, 0
'Access
References.AddFromGuid "{4AFFC9A0-5F99-101B-AF4E-00AA003F0F07}", 0, 0
'stdole
References.AddFromGuid "{00020430-0000-0000-C000-000000000046}", 0, 0
'DAO
References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
'Excel
References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 0, 0
'Scripting
References.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 0, 0
'IWshRuntimeLibrary
References.AddFromGuid "{F935DC20-1CF0-11D0-ADB9-00C04FD58A0B}", 0, 0
'Office
References.AddFromGuid "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", 0, 0

ErrHandler:
Select Case Err.Number
Case 32813
Resume Next
Case Is <> 0
 MsgBox "Run-time error '" & Err & "' : " & vbNewLine & vbNewLine & Error(Err)
Case Else
End Select

End Sub
查看更多
迷人小祖宗
3楼-- · 2020-03-05 03:09

While Siddharth's solution is very handy, I thought I would offer these functions from a tool I rolled out where we were constantly getting calls that related to the fact the user didn't have the proper references checked in the VBE in their Excel version, for many possible reasons.

Just throwing it out as an option and something to look it. There are some very project specific features in it, but you could modify it to work with your needs probably pretty easily.

Function ValidateReferences() As Boolean
'makes sure that user has the proper references installed for downloading data through API

Dim arrDescription() As String, arrGUID() As String
Dim arrMajor() As Long, arrMinor() As Long
Dim strMessage As String


ValidateReferences = True

'removes any broken references
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
    If ThisWorkbook.VBProject.References.Item(i).IsBroken Then ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References.Item(i)
Next

'will attempt to add the reference for the user
arrGUID() = Split("{2A75196C-D9EB-4129-B803-931327F72D5C},{E6C9285A-7A87-407A-85E7-D77A70C100F5},{45A929B3-E493-4173-B6E5-0CD42041C6DC},{F24B7FA2-8FB9-48B7-825F-7C9F4A82F917},{7A80DAB5-1F61-4F9A-A596-561212ACD705},{18142BD6-1DE1-412B-991C-31C7449389E6},{C3ED6DC2-BED0-4599-A170-B1E1E32C627A}", ",", , vbTextCompare) ' {2A75196C-D9EB-4129-B803-931327F72D5C}
arrDescription() = Split("Microsoft ActiveX Data Objects 2.8 Library,myDummyRef COM 3.8.0,myDummyRef COM 3.8.0,myDummyRef COM 3.8.0,myDummyRef 3.6.0 Library,myDummyRef,myDummyRef Library", ",", , vbTextCompare) 'Microsoft ActiveX Data Objects 2.8 Library
ReDim arrMajor(6)
    arrMajor(0) = 0 '0
    arrMajor(1) = 3 '3
    arrMajor(2) = 3 '3
    arrMajor(3) = 3 '3
    arrMajor(4) = 3 '3
    arrMajor(5) = 1 '1
    arrMajor(6) = 1 '1 -> ADODB = 2
ReDim arrMinor(6)
    arrMinor(0) = 0
    arrMinor(1) = 8
    arrMinor(2) = 8
    arrMinor(3) = 8
    arrMinor(4) = 6
    arrMinor(5) = 0
    arrMinor(6) = 0 '-> ADODB = 8

For i = LBound(arrGUID()) To UBound(arrGUID())
    On Error GoTo ErrCheck
    If i = 0 Then 'adodb not working on AddFromFile. I could use add from file on all references, perhaps? -> refactor later
        ThisWorkbook.VBProject.References.AddFromFile ("C:\Program Files\Common Files\System\ado\msado15.dll")
    Else
        ThisWorkbook.VBProject.References.AddFromGuid arrGUID(i), arrMajor(i), arrMinor(i)
    End If
Next

If ValidateReferences = False Then MsgBox "The following references could not be added to the VB Project: " & Right(strMessage, Len(strMessage) - 2) & "." & vbNewLine & vbNewLine & "Please refer to 4. Appropriate DLL Files on the 'Connectivity_Help' tab for more information."

Exit Function

ErrCheck:
    Select Case Err.Number
        Case Is = 32813 'reference already in use, nothing to report
        Case Else
            ValidateReferences = False
            strMessage = strMessage & ", " & arrDescription(i)
    End Select
    Resume Next

End Function

This function will print your reference information to help you find the dll for it, but the reference has to be checked for it to print it.

Sub print_ref_path()

Dim i As Integer

For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
    Dim strName As String, strPath As String, strGUID as String
    strName = ThisWorkbook.VBProject.References.Item(i).name
    Debug.Print strName
    strPath = ThisWorkbook.VBProject.References.Item(i).FullPath
    Debug.Print strPath
    strGUID = ThisWorkbook.VBProject.References.Item(i).GUID 'think this is right, might need to change
Next

End Sub
查看更多
登录 后发表回答