模块/类模块
Access引用类库操作源码实例
2017-06-27 17:21:44

关于类库的引用(即:添加)与 移除操作自定义函数实例源代码

关于类库(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