update linked table via VBA (1 Viewer)

earnhardt08

New member
Local time
Today, 13:34
Joined
Dec 9, 2008
Messages
1
I have a couple Access tables linked to tables in SQL Server 2005. I'm using the "Linked Table Manger" to update these tables; is it possible to do this programmatically using VBA? I'd like to create a form with a button, or something similar.

Thanks!
jason
 

namliam

The Mailman - AWF VIP
Local time
Today, 18:34
Joined
Aug 11, 2003
Messages
11,696
I use this in a form
Code:
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
    Dim tbl As TableDef
    Dim x As Long, MaxX As Long
    Dim tblDB As String
    Me.Visible = False
    tblDB = myFolder & "Folder\Database.MDB"
    If Dir(tblDB) = "" Then
        MsgBox "No table database has been found, " & vbCr & vbCr & _
                "This application will not work, so its beeing closed", vbCritical
        Application.Quit
    End If
                       
    MaxX = 1 ' first count all attached tables
    For Each tbl In CurrentDb.TableDefs()
        If tbl.Attributes = dbAttachedTable Then MaxX = MaxX + 1
    Next tbl
    x = 1 ' Now update them
    For Each tbl In CurrentDb.TableDefs()
        If tbl.Attributes = dbAttachedTable Then
            tblDB = myFolder & Mid(tbl.Connect, InStr(1, tbl.Connect, "Folder\"))
            If tbl.Connect <> ";Database=" & tblDB Then
                Me.Visible = True
                Me.Repaint
                tbl.Connect = ";Database=" & tblDB
                tbl.RefreshLink
            End If
            x = x + 1
        End If
        Me.Fill.Width = x / MaxX * Me.FillTo.Width
    Next tbl
    If Me.Visible Then
        Me.lblWait.Caption = "Done relinking ... "
        Me.Repaint
        MaxX = Timer + 2
        Do While Timer <= MaxX
        Loop
    End If
    

    DoCmd.OpenForm "frmMain"
    DoCmd.Close acForm, Me.Name
    
End Sub
Function myFolder()
    myFolder = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
End Function

Which does that very thing for MDB linked tables, pretty sure you can addapt it to work with SQL Server.

Good luck ! & Welcome to AWF
 

NigelShaw

Registered User.
Local time
Today, 17:34
Joined
Jan 11, 2008
Messages
1,573
Hi,

i use this

Code:
Dim CurDB As DAO.Database, tdfLinked As DAO.TableDef
    Dim TBDef As DAO.TableDef, InstallPath As String
    Dim DBPath As String
    Dim strBEPath As String

    strBEPath = DLookup("qryBELocation", "BEPath")
    DBPath = Application.CurrentProject.Path
    
    Set CurDB = CurrentDb
    For Each TBDef In CurDB.TableDefs
            If Len(TBDef.Connect) > 0 Then
            TBDef.Connect = ";DATABASE=" & DBPath & "strBEPath

            TBDef.RefreshLink
        End If
    Next TBDef

exit_RunFirstTime:
    Set CurDB = Nothing
    Set tdfLinked = Nothing
    Set TBDef = Nothing
    Exit Sub

err_RunFirstTime:
    MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbcrf, "An Error has occured in refresh tables"
    Resume exit_RunFirstTime

basically, it gets the path from the table holding the full name of the back. eg. "MyBackEnd.accdb"
Its also self sufficient so the as long as the BE is in the same location as the FE, it doesnt matter where the folder they are in is moved to.

thats it


regs


Nigel
 

baldmosher

New member
Local time
Today, 17:34
Joined
Oct 31, 2013
Messages
9
Sorry to bring up an old thread but it seemed more relevant than starting a new one.... mainly add my 2p, as I worked with a few different ideas and came up with this little function:

Code:
Public Sub acU_RelinkTables(ByVal OldBasePath As String, ByVal NewBasePath As String)
'v1.00 2013-12-04 14:13
'Tweaked by Tom Parish 2013-12-04 baldmosher.com
'pass old & new path to update all linked tables
'and it will go through all the tables in your database and link them to the new location
'Original source: Written by John Hawkins 20/9/99 fabalou.com
'via database.ittoolbox.com/groups/technical-functional/access-l/how-to-programme-the-linked-table-manager-using-vba-in-ms-access-5185870
'Syntax:
' acU_RelinkTables("c:\Users\Yourname\Databases\", "\\NewShare\Databases\)

Dim Dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim TdfCurrentPath As String
Dim u As Integer

Set Dbs = CurrentDb
Set Tdfs = Dbs.TableDefs

Screen.MousePointer = 11  'shows as "working"
'Loop through the tables collection
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
        TdfCurrentPath = Tdf.Connect
        If InStr(TdfCurrentPath, OldBasePath) > 0 Then  'If the current path needs to be changed
On Error Resume Next
            Tdf.RefreshLink 'Refresh the link
            If Err = 3011 Then GoTo OriginalTdfError    'bypasses change if current linked table isn't found
            Tdf.Connect = Replace(TdfCurrentPath, OldBasePath, NewBasePath)   'Set the new source
            Tdf.RefreshLink 'Refresh the link
            If Err = 3011 Then GoTo EscapeOnError    'likely means error in new path - could be critical
            u = u + 1
On Error GoTo 0
        End If
    End If
OriginalTdfError:
Next 'Goto next table

Screen.MousePointer = 0
MsgBox u & " tables have been relinked from " & OldBasePath & " to " & NewBasePath, vbInformation, "Tables Relinked"

Exit Sub
EscapeOnError:
MsgBox "Possible major error: please ensure OldBasePath and NewBasePath are correct - you will now be returned to Debug", vbExclamation, "WARNING"
On Error GoTo 0
Tdf.Connect = TdfCurrentPath 'return to original
Tdf.RefreshLink 'Refresh the link - errors here means the table was missing before... this needs to be resolved
'NB: to continue from where you left off, drag arrow up to Next
End Sub

EDIT: seems to be working OK now
 
Last edited:

Allan.Day

Registered User.
Local time
Tomorrow, 00:34
Joined
May 18, 2013
Messages
25
Hi Nigel

can you upload the sample database?

thank you

allan
Hi,

i use this

Code:
Dim CurDB As DAO.Database, tdfLinked As DAO.TableDef
    Dim TBDef As DAO.TableDef, InstallPath As String
    Dim DBPath As String
    Dim strBEPath As String

    strBEPath = DLookup("qryBELocation", "BEPath")
    DBPath = Application.CurrentProject.Path
    
    Set CurDB = CurrentDb
    For Each TBDef In CurDB.TableDefs
            If Len(TBDef.Connect) > 0 Then
            TBDef.Connect = ";DATABASE=" & DBPath & "strBEPath

            TBDef.RefreshLink
        End If
    Next TBDef

exit_RunFirstTime:
    Set CurDB = Nothing
    Set tdfLinked = Nothing
    Set TBDef = Nothing
    Exit Sub

err_RunFirstTime:
    MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbcrf, "An Error has occured in refresh tables"
    Resume exit_RunFirstTime
basically, it gets the path from the table holding the full name of the back. eg. "MyBackEnd.accdb"
Its also self sufficient so the as long as the BE is in the same location as the FE, it doesnt matter where the folder they are in is moved to.

thats it


regs


Nigel
 

Users who are viewing this thread

Top Bottom