Solved

I need a macro to run Linked Table Manager

Posted on 2009-05-12
2
1,281 Views
Last Modified: 2013-11-27
Hi ALL, I am trying to write a macro that will run the Linked Table Manager and use the "Select ALL" option.  In a macro,  I am able to open Linked Table Manager by using the Action "RunCommand" and the Arguments "LinkedTableManager".  But I can't seem to figure out how to make it "Select ALL" and then select the "OK" button.  Any help would be MOST aprreciated!!
0
Comment
Question by:Krista_Grubb
2 Comments
 
LVL 65

Accepted Solution

by:
rockiroads earned 500 total points
ID: 24365510
I dont know of any way, because that is open as modal, you cant even use sendkeys to select "select all"

If all you want is to pick another db then why not relink via code?

eg
how to relink http://www.mvps.org/access/tables/tbl0009.htm

how to prompt http://www.mvps.org/access/api/api0001.htm
0
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 24868828
If you want to relink your tables to a new or changed database, you can use the code in the snippet. Set a reference to ADOX and use the ReLinkTables procedure, substituting your database path and table names. Or, you can delete the ReLinkTables procedure and use the ReLinkTable procedure from some other code you have.
-Chuck
'===================================================
'  requires:
'    reference(s) to:
'       Microsoft ADO Ext. 6.0 for DDL and Security
'===================================================
Public Sub ReLinkTables()
On Error GoTo HandleError
    ReLinkTable "PathToDb", "TableName1"
    ReLinkTable "PathToDb", "TableName2"
    ReLinkTable "PathToDb", "TableName3"
    ReLinkTable "PathToDb", "TableName4"
ExitHere:
    Exit Sub
HandleError:
    MsgBox "Error:" & err.Number & vbNewLine & _
        err.Description & vbNewLine & _
        "In:ReLinkTables"
    Resume ExitHere
End Sub
 
Public Sub ReLinkTable(ByVal DbPath As String, _
  ByVal TableName As String)
On Error GoTo HandleError
    UnLinkTable TableName
    LinkTable DbPath, TableName
ExitHere:
    Exit Sub
HandleError:
    MsgBox "Error:" & err.Number & vbNewLine & _
        err.Description & vbNewLine & _
        "In:ReLinkTable"
    Resume ExitHere
End Sub
 
 
Public Sub UnLinkTable(ByVal TableName As String)
On Error GoTo HandleError
    Dim cat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Set cat = New ADOX.Catalog
    Set tbl = New ADOX.Table
    cat.ActiveConnection = CurrentProject.Connection
    For Each tbl In cat.Tables
        If tbl.Type = "LINK" Then
            ' if this is the specified table
            If tbl.Name = TableName Then
                ' delete the specified table
                DoCmd.DeleteObject acTable, tbl.Name
            End If
        End If
    Next tbl
    ' clean up
    Set tbl = Nothing
    Set cat = Nothing
ExitHere:
    Exit Sub
HandleError:
    MsgBox "Error:" & err.Number & vbNewLine & _
        err.Description & vbNewLine & _
        "In:UnLinkTable"
    Resume ExitHere
End Sub
 
Public Sub LinkTable(ByVal DbPath As String, _
  ByVal TableName As String)
On Error GoTo HandleError
    Dim strSQL As String
    Dim tbl As ADOX.Table
    Dim intI As Integer
    Dim cat As ADOX.Catalog
    Set cat = New ADOX.Catalog
    Set tbl = New ADOX.Table
    ' if the database path does not exist,
    If Dir(DbPath) = "" Then
        ' warn the user and exit
        MsgBox "This database path does not exist:" & _
            vbNewLine & vbNewLine & DbPath, vbCritical, "Path Invalid"
        GoTo ExitHere
    End If
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & DbPath & ";"
    ' loop through the tables,
    For Each tbl In cat.Tables
        ' if this is the table we are linking,
        If tbl.Name = TableName Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", _
                DbPath, acTable, tbl.Name, tbl.Name, False
        End If
    Next tbl
    ' clean up
    Set tbl = Nothing
    Set cat = Nothing
ExitHere:
    Exit Sub
HandleError:
    Select Case err.Number
        Case 3011
            Resume Next
        Case Else
            MsgBox "Error:" & err.Number & vbNewLine & _
                err.Description & vbNewLine & _
                "In:LinkTable"
            Resume ExitHere
    End Select
End Sub

Open in new window

0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Access 2007 - Want to See Hierarchy of Forms and the Controls They Contain 9 33
Passing variables to a function 6 33
object variable or with block not set 6 25
Modal form 11 29
User Beware!  This is a rather permanent solution to removing your email from an exchange server.  The only way to truly go back is to have your exchange administrator restore your mailbox from backups.  This is usually the option of last resort.  A…
The new Microsoft OS looks great, is easier than ever to upgrade to, it is even free.  So what's the catch?  If you don't change the privacy settings, Microsoft will, in accordance with the (EULA) you clicked okay to without reading, collect all the…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.

813 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now