dynamically link tables to multiple backends (1 Viewer)

rightmeow

New member
Local time
Today, 05:22
Joined
Aug 10, 2016
Messages
4
Hi so I have a database that links to one main backend, however, one of the tables will become incredibly large(contains mass amounts of financial data) and I would like to link this table to a separate database.
On our main menu the user selects the particular fund that they will be working on, on the after update event of this control I am trying to refresh the link for that table, to a different backend database that simply contains that table and the specific data for that fund.

I have read countless forums that all seem to be following the same process, however I cannot get it to work for me and can not figure out why. I am very new to VBA and cant seem to figure it out. Any help or suggestions would be greatly appreciated.

In addition to the code posted below I have also tried variations with refreshing the link instead which also didnt work.

Here is the code I am currently trying to use:

Function ReLinkTable(strTbl As String) As Boolean
Dim dbsTmp As DAO.Database
Dim tdfTmp As DAO.TableDef
Dim strPrefix As String
Dim strFundID As String
Dim strPath As String
Dim strNewConnect As String

On Error GoTo Proc_Err


Set dbsTmp = CurrentDb()
dbsTmp.TableDefs.Delete (strTable)
Set tdfTmp = dbsTmp.CreateTableDefs(strTable)

strID = str(Forms!frmMainMenu!Id)
'real path removed for sesitivity
strPath = "My Path" & Trim(strTable & strID & ".accdb")


With tdfTmp
tdfTmp.Connect = ";DATABASE=" & ";" & strPath
tdfTmp.SourceTableName = strTable
End With


dbsTmp.TableDefs.Append tdfTmp

ReLinkTable = True


Proc_Exit:
dbsTmp.Close
Exit Function

Proc_Err:
ReLinkTable = False
Resume Proc_Exit


End Function
 

RuralGuy

AWF VIP
Local time
Today, 06:22
Joined
Jul 2, 2005
Messages
13,826
While I'm reading I'll start by observing you probably do not have "Option Explicit" at the top of your code (class) module.
 

rightmeow

New member
Local time
Today, 05:22
Joined
Aug 10, 2016
Messages
4
I did not have it, would this replace Option Compare Database? My apologies if this is a silly question. new to VBA and self taught
In addition, to avoid confusion I also forgot to remove a few old variables that I had been trying before (strPrefix, strNewConnection)
 

RuralGuy

AWF VIP
Local time
Today, 06:22
Joined
Jul 2, 2005
Messages
13,826
It would be in addition to Option Compare Database. All of my class modules begin with:
Option Compare Database
Option Explicit
 

rightmeow

New member
Local time
Today, 05:22
Joined
Aug 10, 2016
Messages
4
good to know, thanks! i added that but still nothing seems to be happening
 

RuralGuy

AWF VIP
Local time
Today, 06:22
Joined
Jul 2, 2005
Messages
13,826
You may want to add:
dbsTmp.TableDefs.Append tdfTmp
dbsTmp.TableDefs.RefreshLink
 

rightmeow

New member
Local time
Today, 05:22
Joined
Aug 10, 2016
Messages
4
For anyone looking to do this, finally got it to work with this!



Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean

'************************************************************************************
'* Create an attached table in the current database from a table in a different MDB file.
'* In: *
'* strTable - name of linked table to create *
'* strPath - path and name of MDB file containing the table *
'* strBaseTable - name of table in strPath MDB *
'* Out: *
'* Return value: True/False, indicating success *
'* Modifies: *
'* Nothing, but adds a new table. *
'************************************************************************************

On Error GoTo CreateAttachedError

Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database

DoCmd.SetWarnings False
Set myDB = CurrentDb
myDB.TableDefs.Delete (strTable)
Set tdf = myDB.CreateTableDef(strTable)
With tdf
.Connect = ";DATABASE=" & strPath
.SourceTableName = strBaseTable
End With

myDB.TableDefs.Append tdf

fRetval = True

DoCmd.SetWarnings True

CreateAttachedExit:
createAttached = fRetval
Exit Function

CreateAttachedError:
If Err = 3110 Then
Resume CreateAttachedExit
Else
If Err = 3011 Then
Resume Next
End If
End If

End Function
 

RuralGuy

AWF VIP
Local time
Today, 06:22
Joined
Jul 2, 2005
Messages
13,826
Thanks for posting back with your success and solution. Did you use the Thread Tools at the top of the thread to mark this thread as Solved?
 

Users who are viewing this thread

Top Bottom