none
Error: -2147467259

    Question

  • I wrote the following routine in VBA in order to automate linking tables in Access 2007.  It worked for a while, then I started getting this error. 

    The routine is supposed to redirect a link if one already exists or to create a new link if it does not exist. 

    '' This is VBA from Access 2007
    
    Sub ReLink_JetTable(strTableName As String, strLinkDb As String, strLinkPath As String)
        Dim conn As ADODB.Connection
        Dim strConn As String
        Dim cat As ADOX.Catalog
        Dim lnkOldTable As ADOX.Table
        Dim lnkNewTable As ADOX.Table
        Dim lstTables As ADOX.Tables
        Dim strDB As String
        
        On Error GoTo ErrorHandler
        
        strDB = strLinkPath & "\" & strLinkDb
        
        Set conn = New ADODB.Connection
        
        strConn = CurrentProject.BaseConnectionString '     "Provider=Microsoft.Jet.OLEDB.4.0;DataSource=" & CurrentProject.FullName
        ' conn.Open strConn
        
        Set cat = New ADOX.Catalog
        
        cat.ActiveConnection = CurrentProject.Connection
        
        Set lnkNewTable = New ADOX.Table
        
        ' setup to build link to new table
        With lnkNewTable
            ' Name the new Table and set it's ParentCatalog property to the
            ' open Catalog to allow access to the Properties collection.
            .Name = strTableName
            Set .ParentCatalog = cat
            
            ' Set the properties to create the link
            .Properties("Jet OLEDB:Create Link") = True
            .Properties("Jet OLEDB:Link Datasource") = strDB
            .Properties("Jet OLEDB:Remote Table Name") = strTableName
        End With
        
        Set lstTables = cat.Tables
        
        ' search the Tables collection for the table to be re-linked
        For Each lnkOldTable In lstTables
            ' search by name to see if it already exists as a linked table
            ' Debug.Print lnkOldTable.Name & ": " & lnkOldTable.Type
            If (lnkOldTable.Name = strTableName) Then
                If (lnkOldTable.Type = "LINK") Then
                    cat.Tables.Delete lnkOldTable.Name
                    Exit For
                Else
    
                    Err.Raise 52
                End If
            End If
        Next
        cat.Tables.Append lnkNewTable  ' <<<<<< Location of error    
        Set cat = Nothing
        
        Debug.Print "The current database contains a linked table named " & strTableName
            
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & ": " & Err.Description
    
    End Sub
    
    

     

     

    • Moved by Mike Feng Monday, October 03, 2011 9:40 AM Access (From:Visual Basic Language)
    Friday, September 30, 2011 1:45 PM

Answers

All replies