Access开发平台--登陆时如何自动引用DAO3.6方法

时　间:2017-02-15 10:19:48
作　者:杜超   ID：16058  城市：江阴
摘　要:经常遇到'Mid'函数未定义，DAO类型未定义等错误一般手动重新引用DAO3.6就可以解决问题了。那如何让平台自动引用呢，方法如下
正　文:

点击下载示例平台.rar

 将以下代码复制替换到模块basRDPStartup中就行了

Option Compare Database
Option Explicit

Public Function ReAddRDPLibReference()
    On Error Resume Next
    Dim strMDE As String: strMDE = CurrentDb.Properties("MDE")
    On Error GoTo ErrorHandler

    If strMDE = "T" Then Exit Function

    Dim strLib As String
    Dim strDao As String
    #If Win64 Then
        strLib = CurrentProject.Path & "\RDPLib.x64.ucl"
    #Else
        strLib = CurrentProject.Path & "\RDPLib.x86.ucl"
    #End If

    If FolderExists("C:\Windows\SysWOW64") Then
        strDao = "C:\Program Files (x86)\Common Files\microsoft shared\DAO\dao360.dll"
    Else
        strDao = "C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll"

    End If

    Dim ref As Reference
    For Each ref In Application.References
        On Error Resume Next
        Dim strRef As String: strRef = ""
        strRef = ref.FullPath
        On Error GoTo ErrorHandler
        If strRef Like "*\RDPLib*.ucl" Then
            Application.References.Remove ref
        ElseIf strRef Like "*DAO*" Then
            Debug.Print strRef
            Application.References.Remove ref
        End If
    Next

    Application.References.AddFromFile strLib

    Application.References.AddFromFile strDao
ExitHere:
    Exit Function

ErrorHandler:
    MsgBox Err.Description & vbCrLf & strLib, vbCritical, "Reference Error #" & Err
End Function


Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    Dim lngAttributes As Long
    lngAttributes = (vbReadOnly or vbHidden or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes or vbDirectory)
    Else
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

    On Error Resume Next
    FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function

Function FolderExists(strPath As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function