Access911.net   |   a9BBS   |   OTaA System  
  搜索文章:  
Access911欢迎您光临  
   主页      上传      繁體版       论坛     
设为首页  |  加入收藏   
  
你现在的位置:文章索引 -> 文章分类 -> 表  
 首页|  近日更新|  下载  |  文章索引  |  搜索|  术语|  承接工程|  
 
系统正在加载内容,请耐心等待...
 
 查询
 窗体
 报表
 
 
 VBA
 函数
 ADO/DAO/ADO.NET
 API
 ADP
 安全
 发布
 OA
 ASP/ASP.NET
 其他语言
 控件
 DELPHI
 C#/.Net
 本站
 其他
 小例程
 常用软件
 参考文档
 业主作品
 网友大作
 
 
友情链接
 access911.net
 
访问人次
 1702835
 
站长 E-Mail
 net911@sina.com
 access911@gmail.com
 
RSS 订阅

显示附加信息 >>>

如何用代码重新链接 ODBC 链接表?1

作者:Dev Ashish  摘自:http://www.mvps.org/access/tables/tbl0010.htm  :cg1  更新日期:2002-11-20  浏览人次:

 

如何用代码重新链接 ODBC 链接表

 Tables: Relink ODBC tables from code
 Author(s) 
Dev Ashish 
 
 
    Personally, I find the manual steps required to link to an ODBC table rather annoying.  If you feel the same way, here's how to automate the whole process.

    I'd suggest creating a table with three fields,

LocalTableName -- The name of the ODBC table as it appears in the Database window.

ConnectString -- The complete connect string to the ODBC Table. (Can be viewed by 

?CurrentDB.TableDefs("SomeODBCTable").Connect

SourceTable -- The actual name of the ODBC table in the Data source. May be the same as Local Table Name.

Store this information for all ODBC tables in this table (referred to as tblReconnectODBC in code).  The benefit is that when this code is run in a new mdb, it re-creates a tabledef for each entry in this table if no ODBC Links are found in the database.

    If you want, you can also add RegisterDatabase method to this code when the DSNs are not found in registry. I, unfortunately, haven't had any luck with it since I'm dealing with Oracle.


'****************** Code Start *********************>
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Option Compare Database
Option Explicit

Private Type tODBCInfo
    strTableName As String
    strNewName As String
    strConnectString As String
    strSourceTable As String
End Type

'Contains all info for tables
Private mastODBCInfo() As tODBCInfo

'*** Registry stuff
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const Synchronize = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                        KEY_QUERY_VALUE Or _
                        KEY_ENUMERATE_SUB_KEYS Or _
                        KEY_NOTIFY) And _
                        (Not Synchronize))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
        Alias "RegOpenKeyExA" _
        (ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As Long) _
        As Long

Private Declare Function apiRegCloseKey Lib "advapi32.dll" _
        Alias "RegCloseKey" _
        (ByVal hKey As Long) _
        As Long

Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
        Alias "RegQueryValueExA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        ByRef lpType As Long, _
        lpData As Any, _
        ByRef lpcbData As Long) _
        As Long

Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
        Alias "RegQueryInfoKeyA" _
        (ByVal hKey As Long, _
        ByVal lpClass As String, _
        ByRef lpcbClass As Long, _
        ByVal lpReserved As Long, _
        ByRef lpcSubKeys As Long, _
        ByRef lpcbMaxSubKeyLen As Long, _
        ByRef lpcbMaxClassLen As Long, _
        ByRef lpcValues As Long, _
        ByRef lpcbMaxValueNameLen As Long, _
        ByRef lpcbMaxValueLen As Long, _
        ByRef lpcbSecurityDescriptor As Long, _
        ByRef lpftLastWriteTime As FILETIME) _
        As Long

Function fReconnectODBC() As Boolean
Dim db As Database, tdf As TableDef
Dim varRet As Variant, rs As Recordset
Dim strConnect As String
Dim intTableCount As Integer
Dim i As Integer
Dim strTmp As String, strMsg As String
Dim boolTablesPresent As Boolean
Const cERR_NODSN = vbObjectError + 300
Const cREG_PATH = "Software\ODBC\ODBC.INI"

    On Error GoTo fReconnectODBC_Err

    'Check to make sure ODBC DSNs are present
    'You can follow the same steps to check for multiple DSNs
    strTmp = fReturnRegKeyValue(HKEY_CURRENT_USER, _
                        cREG_PATH & "\qc03", "Server")
    If strTmp = vbNullString Then Err.Raise cERR_NODSN

    'Another ODBC DSN
    strTmp = fReturnRegKeyValue(HKEY_CURRENT_USER, _
                        cREG_PATH & "\PMIP", "Server")
    If strTmp = vbNullString Then Err.Raise cERR_NODSN


    If MsgBox("Is it ok to drop ODBC links and reconnect?" _
                & vbCrLf & vbCrLf & _
                "The linked ODBC tables will be renamed " _
                & "and then reconnected. " _
                & vbCrLf & "If there were no errors encountered, " _
                & "then the old tables links will be deleted.", _
                vbQuestion + vbYesNo, _
                "Please confirm") = vbYes Then
        Set db = CurrentDb
        intTableCount = 0
        varRet = SysCmd(acSysCmdSetStatus, "Storing ODBC link info.....")

        Set rs = db.OpenRecordset("tblReconnectODBC", dbOpenSnapshot)

        boolTablesPresent = False
        For Each tdf In db.TableDefs
            strConnect = tdf.Connect
            If Len(strConnect) > 0 And left$(tdf.Name, 1) <> "~" Then
                If left$(strConnect, 4) = "ODBC" Then
                    ReDim Preserve mastODBCInfo(intTableCount)
                    With mastODBCInfo(intTableCount)
                        .strTableName = tdf.Name
                        rs.FindFirst "TableName='" & .strTableName & "'"
                        If Not rs.NoMatch Then
                            .strConnectString = rs!ConnectString
                            .strSourceTable = rs!SourceTable
                        Else
                            .strSourceTable = tdf!SourceTableName
                            .strConnectString = tdf!ConnectString
                        End If
                    End With
                    boolTablesPresent = True
                    intTableCount = intTableCount + 1
                End If
            End If
        Next

        'now attempt relink
        If Not boolTablesPresent Then
            'No ODBC Tables present yet
            'Reconnect from the table info
            strMsg = "No ODBC tables were found in this database." & vbCrLf _
                            & "Do you wish to reconnect to all the ODBC sources " _
                            & "listed in 'tblReconnectODBC' tables?"
            If MsgBox(strMsg, vbYesNo + vbQuestion, "ODBC Tables not present") = _
                            vbYes Then
                With rs
                    .MoveFirst
                    Do While Not .EOF
                        varRet = SysCmd(acSysCmdSetStatus, "Relinking '" _
                                            & !TableName & "'.....")
                        Set tdf = db.CreateTableDef(!TableName, _
                                            dbAttachSavePWD, _
                                            !SourceTable, _
                                            !ConnectString)
                        db.TableDefs.Append tdf
                        db.TableDefs.Refresh
                        .MoveNext
                    Loop
                End With
            End If
        Else
            For i = 0 To intTableCount - 1
                With mastODBCInfo(i)
                    varRet = SysCmd(acSysCmdSetStatus, "Attempting to relink '" _
                                        & .strTableName & "'.....")
                    strTmp = Format(Now(), "MMDDYY-hhmmss")
                    db.TableDefs(.strTableName).Name = .strTableName & strTmp
                    db.TableDefs.Refresh
                    .strNewName = .strTableName & strTmp
                    Set tdf = db.CreateTableDef(.strTableName, _
                                                                dbAttachSavePWD, _
                                                                .strSourceTable, _
                                                                .strConnectString)
                    db.TableDefs.Append tdf
                    db.TableDefs.Refresh
                    DoCmd.DeleteObject acTable, .strNewName
                End With
            Next
        End If
    End If
    varRet = SysCmd(acSysCmdClearStatus)
    fReconnectODBC = True
    MsgBox "All ODBC tables were successfully reconnected.", _
                    vbInformation + vbOKOnly, "Success"

fReconnectODBC_Exit:
    Set tdf = Nothing
    Set db = Nothing
    Erase mastODBCInfo
Exit Function
fReconnectODBC_Err:
    Dim errX As Error

    If Errors.Count > 1 Then
        For Each errX In Errors
            strMsg = strMsg & "Error #: " & errX.Number & vbCrLf & errX.Description
        Next
        MsgBox strMsg, vbOKOnly + vbExclamation, "ODBC Errors in reconnect"
    Else
        If Err.Number = cERR_NODSN Then
            MsgBox "The User DSN for Oracle Tables were not found. Please " _
                & "check ODBC32 under Control Panel.", vbExclamation + vbOKOnly, _
                "Couldn't locate User Data Sources"
        Else
            strMsg = "Error #: " & Err.Number & vbCrLf & Err.Description
            MsgBox strMsg, vbOKOnly + vbExclamation, "VBA Errors in reconnect"
        End If
    End If
    fReconnectODBC = False

    Resume fReconnectODBC_Exit
End Function


Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
                            ByVal strKeyName As String, _
                            ByVal strValueName As String) _
                            As String

Dim lnghKey As Long
Dim strClassName As String
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim ftLastWrite As FILETIME
Dim lngType As Long
Dim lngData As Long
Dim lngTmp As Long
Dim strRet As String
Dim varRet As Variant
Dim lngRet As Long
    On Error GoTo fReturnRegKeyValue_Err
    'Open the key first
    lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
                strKeyName, 0&, KEY_READ, lnghKey)

    'Are we ok?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise lngTmp + vbObjectError

    lngReserved = 0&
    strClassName = String$(MAXLEN, 0):  lngClassLen = MAXLEN
    'Get boundary values
    lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
        lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
        lngMaxClassLen, lngValues, lngMaxValueNameLen, _
        lngMaxValueLen, lngSecurity, ftLastWrite)

    'How we doin?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise lngTmp + vbObjectError

    'Now grab the value for the key
    strRet = String$(MAXLEN - 1, 0)
    lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
    Select Case lngType
        Case REG_SZ
            lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
            varRet = left(strRet, lngData - 1)
        Case REG_DWORD
            lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, lngRet, lngData)
            varRet = lngRet
        Case REG_BINARY
            lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
            varRet = left(strRet, lngData)
    End Select

    'All quiet on the western front?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise lngTmp + vbObjectError

fReturnRegKeyValue_Exit:
    fReturnRegKeyValue = varRet
    lngTmp = apiRegCloseKey(lnghKey)
    Exit Function
fReturnRegKeyValue_Err:
    varRet = vbNullString
    Resume fReturnRegKeyValue_Exit
End Function
'****************** Code End *********************
 



摘自: http://www.mvps.org/access/tables/tbl0010.htm

 

 
相关文章
     如何进行ODBC注册?2
     如何用 VBA 新建链接表
     ODBC标量函数(6)(英文)——SQL 92 CAST 函数
     ODBC标量函数(5)(英文)——数据类型转换函数
     ODBC标量函数(4)(英文)——系统函数
     ODBC标量函数(3)(英文)——日期时间函数
     ODBC标量函数(2)(英文)——数值函数
     ODBC标量函数(1)(英文)——字符串
     新手来看:ole db和odbc数据提供者有什么不同?
     如何链接有密码保护的数据库?如何链接打开加密的数据库?
     如何使用ADOX/DAO刷新/更新/删除并重定义链接表 
 
评论
     查看或发表更多的评论,请单击这里。
 
 
 
 
 
   
  Access911.net   |   a9BBS   |   OTaA System   |
建站日期:2000年4月2日  |  设计施工:陈格 ( access911 & cg1 )
 Copyright © 2000 - 2003 COMET, 陈格 保留所有权利