Access交流网
电 话：0760-88315075
热 线：0760-88315075
邮 编：528463
咨询QQ：1918333016
营销QQ：4008553990
Email：1918333016@qq.com
关于类库的引用（即：添加）与 移除操作自定义函数实例源代码
关于类库(Class Library)可能很多读者都不知道是什么？它是一个综合性的面向对象的可重用类型集合，这些类型包括：接口、抽象类和具体类。
简单来说就是一些内置的函数集合。Access之所以不能脱离Access环境执行exe文件原因也在这里。因为Access需要引用access自带的类库。通过这里类，我们才能运行一些函数。
Option Compare Database
Option Explicit
Dim OFName As OPENFILENAME
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Function ShowOpen() As String
'设置结构大小
OFName.lStructSize = Len(OFName)
'设置窗口句柄
OFName.hwndOwner = Form_frmMain.hWnd
'设置应用程序例程
OFName.hInstance = CurrentProject.Application.hWndAccessApp
'设置过滤条件
OFName.lpstrFilter = "ACCESS文件 (*.dll)" + Chr$(0) + "*.dll" + Chr$(0) + "所有文件 (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'创建文件缓存
OFName.lpstrFile = Space$(254)
'设置文件最大字符数
OFName.nMaxFile = 255
'创建对话框标题缓存
OFName.lpstrFileTitle = Space$(254)
'设置最大标题字符数
OFName.nMaxFileTitle = 255
'设置初始目录
OFName.lpstrInitialDir = CurDir
'设置对话框标题
OFName.lpstrTitle = "打开ACCESS文件对话框:"
'文件打开方式标志
OFName.flags = 0
'显示打开文件对话框
If GetOpenFileName(OFName) Then
ShowOpen = Trim$(OFName.lpstrFile)
Else
ShowOpen = ""
End If
End Function
'------------------------------
'功能说明列出所有引用类库过程
'------------------------------
Sub listRefrences()
Dim I As Integer
For I = 1 To Application.References.Count
List1.AddItem Application.References(I).Name & ";" & Application.References(I).FullPath
Next I
End Sub
'-------------------------------
'功能说明:添加引用类库
'-------------------------------
Private Sub Command2_Click()
Dim sFile As String
sFile = ShowOpen
If sFile = "" Then Exit Sub
AddReference (sFile)
Form_Load
End Sub
'-------------------------------
'功能说明：删除引用类库
'-------------------------------
Private Sub Command3_Click()
If MsgBox("你确定要移除该类库吗？", vbQuestion + vbOKCancel, "系统提示：") = vbCancel Then Exit Sub
RemoveReference
Form_Load
End Sub
'-------------------------------
'功能说明：添加引用类库函数
'-------------------------------
Function AddReference(strFile As String) As Boolean
Dim ref As Reference
On Error GoTo Error_AddReference
'= "C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll"
' 添加引用类库
Set ref = References.AddFromFile(strFile)
AddReference = True
Exit_AddReference:
Exit Function
Error_AddReference:
MsgBox "你已经添加了该类库！", vbInformation, "系统提示："
AddReference = False
Resume Exit_AddReference
End Function
'-------------------------------
'功能说明：移除引用类库函数
'-------------------------------
Function RemoveReference() As Boolean
Dim ref As Reference
On Error GoTo Error_RemoveReference
Set ref = References(List1.ListIndex + 1)
' 删除引用的类库
References.Remove ref
RemoveReference = True
Exit_RemoveReference:
Exit Function
Error_RemoveReference:
MsgBox Err & ": " & Err.Description
RemoveReference = False
Resume Exit_RemoveReference
End Function
