Database Table Variables: Access, VBA

I have a procedure that intercepts all tables in a database that are bound to whether they are a connected network. It is currently set to start automatically, as it is installed inside the AutoExec macro, which calls the function.

The code works, but only if I close the database and open it again . I know that this is because it needs to be done in order for the new links to take effect, but anyway around this? Or, if it is not, would it be better to make the VBA code close the database and reopen it?

Thanks in advance for your feedback.

PS Here is the code if you're interested:

'******************************************************************* '* This module refreshes the links to any linked tables * '******************************************************************* 'Procedure to relink tables from the Common Access Database Public Function RefreshTableLinks() As String On Error GoTo ErrHandler Dim strEnvironment As String strEnvironment = GetEnvironment Dim db As DAO.Database Dim tdf As DAO.TableDef Dim strCon As String Dim strBackEnd As String Dim strMsg As String Dim intErrorCount As Integer Set db = CurrentDb 'Loop through the TableDefs Collection. For Each tdf In db.TableDefs 'Verify the table is a linked table. If Left$(tdf.Connect, 10) = ";DATABASE=" Then 'Get the existing Connection String. strCon = Nz(tdf.Connect, "") 'Get the name of the back-end database using String Functions. strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1))) 'Debug.Print strBackEnd 'Verify we have a value for the back-end If Len(strBackEnd & "") > 0 Then 'Set a reference to the TableDef Object. Set tdf = db.TableDefs(tdf.Name) If strBackEnd = "\Common Shares_Data.mdb" Or strBackEnd = "\Adverse Events.mdb" Then 'Build the new Connection Property Value - below needs to be changed to a constant tdf.Connect = ";DATABASE=" & strEnvironment & strBackEnd Else tdf.Connect = ";DATABASE=" & CurrentProject.Path & strBackEnd End If 'Refresh the table links tdf.RefreshLink End If End If Next tdf ErrHandler: If Err.Number <> 0 Then 'Create a message box with the error number and description MsgBox ("Error Number: " & Err.Number & vbCrLf & _ "Error Description: " & Err.Description & vbCrLf) End If End Function 

EDIT

Following on from Gords, I added an AutoExec macro AutoExec to invoke the code below. Does anyone see a problem with this?

 Action: RunCode Function Name: RefreshTableLinks() 
+4
source share
1 answer

The most common mistake in this situation is to forget .RefreshLink TableDef, but you already do it. I just tested the following VBA code that switches the linked table named [Products_linked] between two access files: Products_EN.accdb (English) and Products_FR.accdb (French). If I run VBA code and immediately open the linked table, I see that this change has occurred; I do not need to close and reopen the database.

 Function ToggleLinkTest() Dim cdb As DAO.Database, tbd As DAO.TableDef Set cdb = CurrentDb Set tbd = cdb.TableDefs("Products_linked") If tbd.Connect Like "*_EN*" Then tbd.Connect = Replace(tbd.Connect, "_EN", "_FR", 1, 1, vbBinaryCompare) Else tbd.Connect = Replace(tbd.Connect, "_FR", "_EN", 1, 1, vbBinaryCompare) End If tbd.RefreshLink Set tbd = Nothing Set cdb = Nothing End Function 

I even tested calling this code from an AutoExec macro, and it also works as expected.

One thing you could try would be to call db.TableDefs.Refresh at the end of your procedure to see if that helps.

Edit

The problem was that the database had a “display form” specified in the “Application Settings”, and this form appears to automatically open before the AutoExec macro runs. Moving a function call to re-bind the code to the Form_Load event handler for this "launch form" seems like a likely fix.

+5
source

Source: https://habr.com/ru/post/1479514/


All Articles