程序做好给别人使用的时候总会出现丢失引用的现象，程序中会经常使用到dao、ado、adox对象

下面的示例是一个动态引用的模块，可以动态引用dao、ado、adox。即不需要手动去应用ado等内容。

需要把本函数放在模块中，且把lib目录放在当前目录中，否则会找不到引用库。

 

Public Function addref(refName As String)

'****************************************************************

'*模块设计: 李寻欢

'*邮箱:vba@accfans.net

'*****************************************************************

'用法：

'1、引用Ado：addref "ADO"

'2、引用ADOX：addref "ADOX"

'3、引用DAO：addref "DAO"

'******************************************************************

 

Dim strCpath As String

Dim ref As Reference

Dim strFileName As String

 

On Error GoTo Err_add_ref

    

    strCpath = CurrentProject.Path

    If Right(strCpath, 1) <> "\" Then

        strCpath = strCpath & "\"

    End If

    Select Case refName

        Case "ADO"

            If Dir(strCpath & "lib\msado15.dll") = "" Then

                MsgBox "找不到ADO引用库，引用失败！", vbCritical, "动态引用"

                Exit Function

            Else

                strFileName = strCpath & "lib\msado15.dll"

            End If

        Case "ADOX"

            If Dir(strCpath & "lib\msadox.dll") = "" Then

                MsgBox "找不到ADOX引用库，引用失败！", vbCritical, "动态引用"

                Exit Function

            Else

                strFileName = strCpath & "lib\msadox.dll"

            End If

        Case "DAO"

            If Dir(strCpath & "lib\dao360.dll") = "" Then

                MsgBox "找不到ADOX引用库，引用失败！", vbCritical, "动态引用"

                Exit Function

            Else

                strFileName = strCpath & "lib\dao360.dll"

            End If

        Case Else

            MsgBox "不支持的引用字符串，引用失败！", vbCritical, "动态引用"

            Exit Function

    End Select

    

    Set ref = References(refName)

    Application.References.Remove ref

    Set ref = Application.References.AddFromFile(strFileName)

Exit_add_ref:

    Exit Function

    

Err_add_ref:

    'MsgBox Err.Description

    Resume Next

    

End Function