Office中国论坛/Access中国论坛

标题: 求救,ODBC链接表问题 [打印本页]
作者: yedaoan    时间: 2012-7-28 16:26
标题: 求救,ODBC链接表问题
求救,MDB用ODBC连到SQL 2008中的表,在网络中断又恢复后,MDB中的链接表,好长时间(约10分钟)都无法连接,但用ADO连接测试是可以的,链接表始终连接不上,
作者: layaman_999    时间: 2012-7-28 17:33
刷新链接表
作者: andymark    时间: 2012-7-29 14:02
刷新连接表不能觖决的话，可以尝试创建新的OBDC再重新连接
作者: yedaoan    时间: 2012-7-30 09:51
如果有刷新链接可以,就不会有这个问题了,无论是有代码刷新还是用ACCESS 自带的链接表管理器,都无法刷新,提示ODBC 调用失败,另尝试很多种链接表的代码,都是一提示,把代码摘录如下:
1 创建链接表的
Private Sub Command1_Click()
    DoCmd.TransferDatabase acLink, "ODBC", _
        "ODBC;DSN=ERP2012;UID=saWD=123456;LANGUAGE=us_english;" _
        & "DATABASE=ERP2012", acTable, "CP_CPZD", "CP_CPZD", True

End Sub
2 ODBC刷新链表的
Public Function Relink() As Boolean
    Dim strCn As String
    Dim strSrv As String
    Dim strUser As String
    Dim strPWD As String
    Dim strDataBase As String
    Dim Rst_Cprk As Recordset
   
'    '判断通过ADO能否连到服务器
   If ConnectWB = False Then Exit Function
   
    strSrv = Nz(DLookup("[svrName]", "path", "[Bz]='1'"), "")
    strUser = Nz(DLookup("[userName]", "path", "[Bz]='1'"), "")
    strPWD = Nz(DLookup("[pwd]", "path", "[Bz]='1'"), "")
    strDataBase = Nz(DLookup("[dataName]", "path", "[Bz]='1'"), "")
   

    Dim strFileName As String
    Dim tdf As TableDef
    Dim strConnect As String
   
    strConnect = "ODBC;Driver=SQL Server;Server=" & strSrv _
            & ";UID=" & strUser & "WD=" & strPWD & ";DATABASE=" & strDataBase
   
    ' 循环处理此数据库的所有表。
    For Each tdf In CurrentDb.TableDefs
        ' 如果表有一个连接串，那么该表是一个链接表。
         If Len(tdf.Connect) > 0 Then
            tdf.Connect = strConnect
            Err = 0
            On Error Resume Next
            tdf.RefreshLink        ' 重新链接该表。
            If Err <> 0 Then
                Relink = False
                Exit Function
            End If
        End If
    Next tdf
    Relink = True

End Function
3 ADO刷新链表的
Private Sub Command2_Click()
   
    ' strTargetDB: 被链接的数据库路径名
    ' strProviderString: 连接字符串
    ' strSourceTbl: 被链接的源表名称
    ' strLinkTblName: 要重设链接的链接表的名称
    ' 作者：朱亦文

    Dim strTargetDB() As String
    Dim strProviderString() As String
    Dim strSourceTbl() As String
    Dim strLinkTblName() As String
   
    Dim catDB   As ADOX.Catalog
    Dim tblLink As ADOX.Table
    Dim tmpLink As ADOX.Table
   
    Dim i As Integer
    Dim j As Integer

    Set catDB = New ADOX.Catalog
    catDB.ActiveConnection = CurrentProject.Connection
   
    i = catDB.Tables.Count
   
    ReDim strTargetDB(i)
    ReDim strProviderString(i)
    ReDim strSourceTbl(i)
    ReDim strLinkTblName(i)
   
    i = 1
   
    For Each tmpLink In catDB.Tables
        
        If tmpLink.Properties("Jet OLEDB:Create Link") Then
            If Trim(tmpLink.Properties("Jet OLEDB:Remote Table Name")) <> "" Then
            
                Debug.Print tmpLink.Name & " |  " & tmpLink.Properties("Jet OLEDB:Remote Table Name") & " |  " & tmpLink.Properties("Jet OLEDBink Datasource")
               
                strLinkTblName(i) = tmpLink.Name
                strTargetDB(i) = tmpLink.Properties("Jet OLEDBink Datasource")
                strProviderString(i) = tmpLink.Properties("Jet OLEDBink Provider String")
                strSourceTbl(i) = tmpLink.Properties("Jet OLEDB:Remote Table Name")
               
                Do While InStr(1, strTargetDB(i), "\") <> 0
                    strTargetDB(i) = Mid(strTargetDB(i), InStr(1, strTargetDB(i), "\") + 1, Len(strTargetDB(i)))
                Loop
               
                strTargetDB(i) = CurrentProject.Path & "\" & strTargetDB(i)
               
                i = i + 1
            End If
        End If
   
    Next
   
    j = i - 1
   
    For i = 1 To j
        catDB.Tables.Delete strLinkTblName(i)
            
        Set tblLink = New ADOX.Table
            
        With tblLink
            .Name = strLinkTblName(i)
            Set .ParentCatalog = catDB
               
            .Properties("Jet OLEDB:Create Link") = True
            .Properties("Jet OLEDB:Link Datasource") = strTargetDB(i)
            .Properties("Jet OLEDB:Link Provider String") = strProviderString(i)
            .Properties("Jet OLEDB:Remote Table Name") = strSourceTbl(i)
        End With
           
        catDB.Tables.Append tblLink
        Set tblLink = Nothing
    Next
    Set catDB = Nothing


End Sub


以上方法都试,开发环境是 ACCESS 2010 + SQL SERVER 2008 R2
作者: yedaoan    时间: 2012-7-30 09:52
这个问题解决不了,接下来,就没有办法继续下去了
作者: Benjamin_luk    时间: 2012-7-30 15:58
本帖最后由 Benjamin_luk 于 2012-7-30 16:00 编辑

这是我连接用友U890 SQL服务器的方案, 你可以参考一下:
1.在SQL中创建专用的帐号(指定SQL IP)
2.在MDB数据库中使用传递查询 (要加入限制条件)
3.将查询语句用一个表存储这查询,(类型应该是"112")
4.当IP变更时, 用户先测试连接,如果要运用新的参数就将IP等资料在表中先修改,然后再用代码批量生成新的传递查询.

使用查询的最大的好处是
1.可以在查询中加入限制条件, 加快数据的读取速度.
2.不用在电脑上建立任何DSN文件
3.当IP变更时, 也可很灵活的运用.

最后发现数据的读取速度比用友前台操作的速度还快一些.
{:soso_e100:}
作者: Benjamin_luk    时间: 2012-7-30 16:04
这是一个生成传递查询的代码:
Public Function CreatePassSQL(SQLName As String, strSQL As String)
Dim qdfPassThrough As DAO.QueryDef, MyDB As Database
Dim strConnect As String

If IsTableQuery("", SQLName) = True Then 'doesn't exist
CurrentDb.QueryDefs.Delete SQLName
End If

Set MyDB = CurrentDb()

Set qdfPassThrough = MyDB.CreateQueryDef(SQLName)
qdfPassThrough.Connect = U890SQL
qdfPassThrough.SQL = strSQL
qdfPassThrough.ReturnsRecords = True
qdfPassThrough.Close

Application.RefreshDatabaseWindow

''DoCmd.OpenQuery SQLName, acViewNormal, acReadOnly
''DoCmd.Maximize

End Function

Function IsTableQuery(DbName As String, TName As String) As Integer
   Dim Db As Database, Found As Integer, Test As String
   Const NAME_NOT_IN_COLLECTION = 3265
   ' Assume the table or query does not exist.
   Found = False
   ' Trap for any errors.
   On Error Resume Next
   ' If the database name is empty...
   If Trim$(DbName) = "" Then
      ' ...then set Db to the current Db.
      Set Db = CurrentDb()
   Else
      ' Otherwise, set Db to the specified open database.
      Set Db = DBEngine.Workspaces(0).OpenDatabase(DbName)
      ' See if an error occurred.
      If Err Then
         MsgBox "Could not find database to open: " & DbName
         IsTableQuery = False
         Exit Function
      End If
   End If
   ' See if the name is in the Tables collection.
   Test = Db.TableDefs(TName).Name
   If Err <> NAME_NOT_IN_COLLECTION Then Found = True
   ' Reset the error variable.
   Err = 0
   ' See if the name is in the Queries collection.
   Test = Db.QueryDefs(TName$).Name
   If Err <> NAME_NOT_IN_COLLECTION Then Found = True
   Db.Close
   IsTableQuery = Found
End Function
作者: layaman_999    时间: 2012-7-30 16:28
新建一个库，重建建立ODBC链接表,看是否能连上？如果能连上，那么你原来那个库有问题，如果不能连上，可能是你的ODBC配置有问题
作者: yedaoan    时间: 2012-8-1 09:39
谢谢楼上各位的热情回复,上面的这些方法,都试过了,都不行,问题的在关键在,网络一旦断开后,JET引擎就挂了,要重新退出ACCESS再进去,所有基于JET引擎的DAO等都用不了,无论你用什么代码,关键是底层的JET引擎OVER了.
接下的解决方案是ADO了,唉,可怜那好用的ODBC链接表!



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3