Visual Basic Programming Code Examples

Visual Basic > Other Code Examples

Create Access link tables dynamically



Create Access link tables dynamically

The following code demonstrates how to add link tables to another Access database.

Option Explicit

'Purpose     :  Adds a link table from an Access database
'Inputs      :  sLinkFromDB                 The path to the original database.
'               sLinkToDB                   The path to the database to link to.
'               sLinkToTable                The table name to link to in sLinkToDB.
'               [sNewLinkTableName]         The name of the new link table. sLinkFromDB.
'Outputs     :  Returns True if succeeded in linking to the table
'Notes       :  Requires a reference to reference to both ADO (MS ActiveX Data Objects) and MSADOX.DLL
'               (MS ADO Ext. 2.5 DLL and Security).
'Revisions   :

Function AccessLinkToTable(sLinkFromDB As String, sLinkToDB As String, sLinkToTable As String, Optional sNewLinkTableName As String) As Boolean
    Dim CatDB As ADOX.Catalog
    Dim TblLink As ADOX.Table
    
    On Error GoTo ErrFailed
    If Len(Dir$(sLinkFromDB)) > 0 And Len(Dir$(sLinkToDB)) > 0 Then
        'Databases exist
        Set CatDB = New ADOX.Catalog
        'Open a Catalog on database in which to create the link.
        CatDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & sLinkFromDB
        
        Set TblLink = New ADOX.Table
        With TblLink
            'Name the new Table
            If Len(sNewLinkTableName) Then
                .Name = sNewLinkTableName
            Else
                .Name = sLinkToTable
            End If
            
            'Set ParentCatalog property to the open Catalog.
            'This allows access to the Properties collection.
            Set .ParentCatalog = CatDB
            
            'Set the properties to create the link.
            .Properties("Jet OLEDB:Create Link") = True
            .Properties("Jet OLEDB:Link Datasource") = sLinkToDB
            .Properties("Jet OLEDB:Remote Table Name") = sLinkToTable
        End With
        
        'Append the table to the Tables collection.
        CatDB.Tables.Append TblLink
        Set CatDB = Nothing
        'Set return as success
        AccessLinkToTable = True
    End If
    Exit Function

ErrFailed:
    On Error GoTo 0
    AccessLinkToTable = False
End Function