为什么此vba表重新链接代码导致错误3219？ [英] Why does this vba table relink code result in error 3219?

问题描述

我正在尝试重新链接MS Access数据库中的表，该表与以下代码所在的表分开；这样，我可以将修复数据库用作各种补丁 ...

I'm trying to relink tables in an MS Access database separate from the one the code below runs in; this way I can use the repairing db as "patch" of sorts...

我已经修改了找到的代码此处，以便它重新链接打开的数据库中的表通过修复/补丁程序数据库

I've modified the code I found here, so that it relinks the tables in a database opened by the "repairing / patch database"

在运行代码之前，请确保两个数据库都已打开，以便一个数据库可以修复另一个数据库，从而使应用程序自动化更加容易

Before I run the code I make sure both databases are open so that one can repair the other to make it easier to automate the application of the fix.

但是，当我运行代码时，当我到达该行时显示为 tdfLinked.RefeshLink ，刷新链接表，我得到一个运行时错误'3219'无效操作错误。

However when I run the code, when I get to the line reads tdfLinked.RefeshLink, which refreshes the linked table, I get an Runtime error '3219' Invalid Operation error.

Sub FixDB()

    Call LinkTable("somelinkedTble", "SOMESERVER\NAMED_SQL_INST32", "Database1", "Some_Schema.somelinkedTble", True)

End Sub

Function LinkTable(LinkedTableAlias As String, Server As String, database As String, SourceTableName As String, OverwriteIfExists As Boolean)
    'This method will also update the link if the underlying table definition has been modified.

    'The overwrite parameter will cause it to re-map/refresh the link for LinktedTable Alias, but only if it was already a linked table.
    ' it will not overwrite an existing query or local table with the name specified in LinkedTableAlias.

    ' Begin: Bit that I modified to access the database that needs fixed.
    Dim objAccess As Access.application
    Dim loginInfo As New AuthInfoz

    loginInfo.workgroup = "E:\Tickets\Fix\SEC\Secured.mdw"
    loginInfo.username = "someuser"
    loginInfo.password = "********"
    loginInfo.dbs = "E:\Tickets\Fix\Report.mdb"

    Set objAccess = GetObject(loginInfo.dbs).application

    'Links to a SQL Server table without the need to set up a DSN in the ODBC Console.
    Dim dbsCurrent As database
    Dim tdfLinked As TableDef

    ' Open a database to which a linked table can be appended.
    Set dbsCurrent = objAccess.CurrentDb

    ' END: Bit that I modified to access the external database.

    'Check for and deal with the scenario ofthe table alias already existing
    If TableNameInUse(LinkedTableAlias) Then

        If (Not OverwriteIfExists) Then
            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite existing table."
            Exit Function
        End If

        'delete existing table, but only if it is a linked table
        If IsLinkedTable(LinkedTableAlias) Then
            dbsCurrent.TableDefs.Delete LinkedTableAlias
            dbsCurrent.TableDefs.Refresh
        Else
            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite an existing query or local table."
            Exit Function
        End If
    End If

    'Create a linked table
    Set tdfLinked = dbsCurrent.CreateTableDef(LinkedTableAlias)
    tdfLinked.SourceTableName = SourceTableName
    tdfLinked.Connect = "ODBC;DRIVER={SQL Server};SERVER=" & Server & ";DATABASE=" & database & ";TRUSTED_CONNECTION=yes;"

    On Error Resume Next
    dbsCurrent.TableDefs.Append tdfLinked
    If (Err.Number = 3626) Then 'too many indexes on source table for Access
            Err.Clear
            On Error GoTo 0

            If LinkTable(LinkedTableAlias, Server, database, "vw" & SourceTableName, OverwriteIfExists) Then
                Debug.Print "Can't link directly to table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Linked to view '" & "vw" & SourceTableName & "' instead."
                LinkTable = True
            Else
                Debug.Print "Can't link table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Create a view named '" & "vw" & SourceTableName & "' that selects all rows/columns from '" & SourceTableName & "' and try again to circumvent this."
                LinkTable = False
            End If
            Exit Function
    End If
    On Error GoTo 0

    tdfLinked.RefreshLink
    LinkTable = True

End Function

Function BuildSQLConnectionString(Server As String, DBName As String) As String
    BuildSQLConnectionString = "Driver={SQL Server};Server=" & Server & ";Database=" & DBName & ";TRUSTED_CONNECTION=yes;"
End Function

Function TableNameInUse(TableName As String) As Boolean
    'check for local tables, linked tables and queries (they all share the same namespace)
    TableNameInUse = DCount("*", "MSYSObjects", "(Type = 4 or type=1 or type=5) AND [Name]='" & TableName & "'") > 0
End Function

Function IsLinkedTable(TableName As String) As Boolean
    IsLinkedTable = DCount("*", "MSYSObjects", "(Type = 4) AND [Name]='" & TableName & "'") > 0
End Function

推荐答案

您应该可以采用：

Public Function AttachSqlServer( _
    ByVal Hostname As String, _
    ByVal Database As String, _
    ByVal Username As String, _
    ByVal Password As String) _
    As Boolean

' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS, CPH.

    Const cstrQuery1    As String = "_Template"
    Const cstrQuery2    As String = "_TemplateRead"
    Const cstrQuery3    As String = "VerifyConnection"

    Const cstrDbType    As String = "ODBC"
    Const cstrAcPrefix  As String = "dbo_"

    Dim dbs             As DAO.Database
    Dim tdf             As DAO.TableDef
    Dim strConnect      As String
    Dim strName         As String

    On Error GoTo Err_AttachSqlServer

    Set dbs = CurrentDb
    strConnect = ConnectionString(Hostname, Database, Username, Password)

    For Each tdf In dbs.TableDefs
        strName = tdf.Name
        If Asc(strName) <> Asc("~") Then
            If InStr(tdf.Connect, cstrDbType) = 1 Then
                If Left(strName, Len(cstrAcPrefix)) = cstrAcPrefix Then
                    tdf.Name = Mid(strName, Len(cstrAcPrefix) + 1)
                End If
                tdf.Connect = strConnect
                tdf.RefreshLink
                Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
                DoEvents
            End If
        End If
    Next
    dbs.QueryDefs(cstrQuery1).Connect = strConnect
    dbs.QueryDefs(cstrQuery2).Connect = strConnect
    dbs.QueryDefs(cstrQuery3).Connect = strConnect
    Debug.Print "Done!"

    AttachSqlServer = True

Exit_AttachSqlServer:
    Set tdf = Nothing
    Set dbs = Nothing
    Exit Function

Err_AttachSqlServer:
    Call ErrorMox
    Resume Exit_AttachSqlServer

End Function

这篇关于为什么此vba表重新链接代码导致错误3219？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！