VBA及Access显示Dll及Ocx控件引用References所有信息及代码动态添加和删除引用
用代码写代码,注意:本文需要有一定的VBA基础及Excel或Access开发经验。
如阅读有些吃力,可以先收藏及关注我们 @小辣椒高效Office
一、列出Excel VBA工程或Access数据库中引用的所有DLL库或ActiveX控件
可以使用下面的参考代码
作者: Office交流网 fans.net版主
Option Compare Database
Dim blnMark As Boolean
Dim intMark As Integer
'当指向 Application 对象的变量超出范围时,它所表示的 Microsoft Access 实例也将关闭。
'所以,必须在模块级说明这个变量。
Dim appAccess As Access.Application
'获取其他Access数据库中引用的所有类库和控件
Function GetRefrencesString(strDB As String) As String
On Error GoTo Err_GetRefrencesString
Dim i As Integer
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase strDB
For i = 1 To appAccess.Application.References.Count
GetRefrencesString = GetRefrencesString & appAccess.Application.References(i).Name & _
":" & vbTab & appAccess.Application.References(i).FullPath & vbCrLf
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Exit_GetRefrencesString:
Exit Function
Err_GetRefrencesString:
Set appAccess = Nothing
MsgBox Err.Description
Resume Exit_GetRefrencesString
End Function
'列出程序中引用的所有类库和控件
Function ListRefrences() As String
Dim i As Integer
For i = 1 To Application.References.Count
ListRefrences = ListRefrences & Application.References(i).Name & ":" & vbTab _
& Application.References(i).FullPath & vbCrLf
End Function
二、DLL链接库或控件的前期引用与后期引用
vba要引用第三方库或控件,就要先添加DLL链接库或控件的引用,有两种引用方式
1)前期引用
前期引用,是在“工具”菜单下的“引用”命令中添加需要引用的库,如下图所示。
2)后期引用
则是使用类似这样的语句创建:
直接用 CreateObject(“Scripting.Dictionary”)语句 这就是后期引用。
如引用Excel对象
Sub GetExcel()
'Bind to an existing or created instance of Microsoft Excel
Dim objApp As Object
'Attempt to bind to an open instance
On Error Resume Next
Set objApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
'Could not get instance, so create a new one
Err.Clear
Set objApp = CreateObject("Excel.Application")
With objApp
.Visible = True
.Workbooks.Add
End With
End If
End Sub
两者区别:
1)前期引用可以直接列出成员属性、方法列表
2)后期引用不可以直接列出成员属性、方法列表。但不会因为控件或DLL不存在,程序一打开就出现引用丢失的情况,不是所有对象或控件均支持后期引用的(tmtony)。另有些有界面和窗体的控件不太方便使用后期引用。
三、通过VBA代码来动态添加前期引用
前期引用一般都是通过手动添加要引用库或ActiveX(OCX)控件的方式实现,但也可以使用vba代码自动添加需要的引用库,这里就要用到 References对象的 AddFromGuid 方法或者 AddFromFile 方法。
1)如果文件位置固定,可以使用 AddFromFile 方法
摘自: Office交流网
可加载一个空窗体如下,注册控件,再启动窗体2打开实际功能。另外也将控件打包成安装包。
Private Sub Form_Open(Cancel As Integer)
DoCmd.RunCommand acCmdAppMinimize
Me.Visible = False
AutoRegFile "控件名"
DoCmd.Close
DoCmd.OpenForm "窗体2"
End Sub
'这是网上高手写的
Function AutoRegFile(FileName As String)
Dim reged As Boolean
Dim RegFile1 As String
Dim RegFile2 As String
Dim BeReg As String, strDtn As String, strDtn1 As String
Dim ref As Reference
Dim RetVal
BeReg = CurrentProject.Path & "\ocx\" & FileName '控件存放位置,例子中是放在工程当前目录下ocx子目录
strDtn = Environ("windir") & "\system\" & FileName '返回系统路径
strDtn1 = Environ("windir") & "\system32\" & FileName '返回系统路径
On Error Resume Next
RegFile1 = Environ("windir") & "\system\regsvr32.exe "
RegFile2 = Environ("windir") & "\system32\regsvr32.exe "
If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then
If Dir(RegFile1) <> "" Then
FileCopy BeReg, strDtn
RegFile1 = RegFile1 & "/s" & " " & strDtn
RetVal = Shell(RegFile1, 1)
' Set ref = References.AddFromFile(Environ("windir") & "\system\" & FileName)
FileCopy BeReg, strDtn1
RegFile2 = RegFile2 & "/s" & " " & strDtn1
RetVal = Shell(RegFile2, 1)
' Set ref = References.AddFromFile(Environ("windir") & "\system32\" & FileName) '设置引用
End If
MsgBox "找不到regsvr32.exe文件,你可能无法使用本软件!", vbCritical, "无法自动注册控件"
End If
End Function
AddFromFile方法是通过添加具体的文件路径的方法来实现引用,这种方法缺点就是,不同的操作系统、不同用户的安装路径可能会不同,这样路径不一致,所以你做好的程序复制到用户或同事的电脑,可能会出错。
所以就要用到我们第2种方法:AddFromGuid方法
2)使用 AddFromGuid 方法动态添加引用
AddFromGuid方法是直接根据全局唯一标识符字符串globally unique identifier (GUID) 来添加引用,这种方法可以跨操作系统、跨版本都有效。一般知名厂家的DLL或OCX 的GUID是统一的。
全局唯一标识符字符串(GUID) 是一个唯一标识符,它不会因为引用的版本号的变化而变化。所以通过AddFromGuid方法可以保证引用的准确性。不会像AddFromFile方法因为路径不同而出错!
3)AddFromGuid方法使用方法如下:
AddFromGuid(Guid, Major, Minor) As Reference
参数guid, major, minor分别表示引用的全局唯一标识符,major 主版本号和minor 小版本号。
AddFromGUID方法基于标识类型库的 GUID创建一个引用对象。参考对象。
参数
姓名 必需/可选 数据类型 描述
指导 必需的 细绳 标识类型库的 GUID。
主要的 必需的 长 参考的主要版本号。
次要的 必需的 长 参考的次要版本号。
GUID属性返回指定引用对象的GUID。如果您存储了GUID属性的值,则可以使用它来重新创建已损坏的引用。
如果您为主要和次要版本参数添加使用 0 的 GUID 引用,它将解析为对象库的最新安装版本。
4) AddFromGuid一些使用 示例
以下示例根据用户系统上的 GUID重新创建对Microsoft Scripting Runtime 1.0 版的引用。
References.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
以下示例添加了对Microsoft Excel 对象库的引用,但不知道当前安装的是哪个版本。
References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 0, 0
为了方便查看这些参数,我们可以通过先手动添加引用的库(如Excel常用的字典库 Scripting.Dictionary),然后用代码获取它的相关属性:
Sub GetRefInfo()
Dim ref As Reference
'遍历显示所有引用的相关信息
For Each ref In ThisWorkbook.VBProject.References
With ref
Debug.Print "引用的名称:" & .Name
Debug.Print "引用的路径:" & .FullPath
Debug.Print "GUID:" & .GUID
Debug.Print "Major:" & .Major
Debug.Print "Minor:" & .Minor
Debug.Print "描述" & .Description
i = i + 1
End With
End Sub
如 Scripting.Dictionary 对应引用是Microsoft Scripting Runtime
GUID: {420B2830-E718-11CF-893D-00A0C9054228}
major: 1
minor: 0
这样就可以通过VBA代码自动 添加Microsoft Scripting Runtime:
如果重复添加 会弹出“名称冲突的提示”,可以先用代码先去除已判断的引用,或判断引用是否存在,或直接跳过错误处理:
Sub AddRef()
On Error Resume Next '或先 用 application.References.Remove 去掉引用
Dim ref As Reference
Set ref = ThisWorkbook.VBProject.References.AddFromGuid("{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0)
End Sub
以下是一些常用的对象的GUID及VBA代码动态添加前期引用的代码:
'excel对象
Set ref = ThisWorkbook.VBProject.References.AddFromGuid("{00020813-0000-0000-C000-000000000046}", 1, 9)
'word对象
Set ref = ThisWorkbook.VBProject.References.AddFromGuid("{00020905-0000-0000-C000-000000000046}", 8, 7)
'ppt对象
Set ref = ThisWorkbook.VBProject.References.AddFromGuid("{91493440-5A91-11CF-8700-00AA0060263B}", 2, 12)
'WinHttp对象
Set ref = ThisWorkbook.VBProject.References.AddFromGuid("{662901FC-6951-4854-9EB2-D9A2570F2B2E}", 5, 1)