Using the following code, it is bloating the database size when refreshing the linked ODBC table connections. As such, the user will never be be able to finish the process completely without closing and re-opening the database for it to compact. The connections are linked from SQL and there are 13 linked tables in the database. The code resets the connection 4 times.
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim rs As DAO.Recordset
Dim strSite As String
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblSites")
'Run query against Default Site to create table
DoCmd.OpenQuery ("qryWarranty01") 'creates tblWarranty
'Loop through Site 2, Site 3 & Site 4 and append data to table
With rs
.MoveFirst
Do While .EOF = False
strSite = rs.Fields("Site")
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = "ODBC;DRIVER={SQL Server};SERVER=ServerName;DATABASE=" & strSite & ";UID=Username; PWD=Password;"
tdf.RefreshLink
End If
Next
DoCmd.OpenQuery "qryWarranty02" 'appends to tblWarranty
.MoveNext
Loop
End With
rs.Close
'Reset tables to be linked to Default Site
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = "ODBC;DRIVER={SQL Server};SERVER=ServerName;DATABASE=Site1;UID=Username; PWD=Password;"
tdf.RefreshLink
End If
Next
I've searched and searched for a resolution beyond Compacting and Repair. Can someone explain to me why the bloat is happening in this code and so fast? Is there another way to accomplish what I am needing to do?
I appreciate your help.
Thanks,
Cara
Here are some possibilities:
Ignore the bloat. Is it so extreme? What is so bad about Repair&Compact?
Only change .Connect and RefreshLink the tables that are used in qryWarranty02, not all 11 tables.
Create a SQL Server view from qryWarranty02, link that view. Now you only have to switch one TableDef.
Use a Pass-Through query instead of the linked view. I don't think changing the .Connect of a PT query causes the same bloat as for a table.
Have 4 Pass-Through queries with fixed connect strings for the 4 databases, and loop through them. No switching anymore (but redundancy in the queries).
That's normal and known (mis)behaviour.
You have no other options than either ignore the bloat (which you safely can do) or perform a compact afterwards.
Related
I have a database that works as a user interface to a few other databases. I link the secondary databases into the "front end" with linked tables.
So I have A.accdb, B.accdb, C.accdb, which all link into UI.accdb.
When I give this to people, some only get A, some only get B, some get A and C, and so on. The databases are expected to all be in the same folder. I am able to update the links by having a macro that relinks the UI back to each using the following (with some error handling).
Dim db As DAO.Database
Dim strConnect As String, dbName As String
Dim tdf As DAO.TableDef
Set db = CurrentDb
strConnect = ";DATABASE=" & CurrentProject.Path & "\"
For Each tdf In db.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = sMyConnectString & dbName
tdf.RefreshLink
End If
Next tdf
My problem is that if a user does not get B, for example, then their table links will not update location and the old file location is still saved in the link (but will not work since they don't have the file). I want to clean this up though.
Is there a way that in the error handling I can set tdf.connect to something that doesn't exist? I cannot set it to Null and I cannot seem to set it to some arbitrary string. Are there any other options to make the link not work, not show the previous location, but still exist? I want it to remain in case they get one of the other databases later.
I can't seem to find any good reference or example of how to get this to work. I have a database which is stored on an AS/400 (my local MS Access database [stored on a network drive] has linked tables to the 400, using ODBC/DSN). My utility works just fine passing SQL statements to through Access to retrieve data from the 400 using the linked tables. The problem is that with some of the larger reports and the fact that the 400 is several states away, it can take several hours to run the reports. The settled on solution to this is to create a local "copy" of the tables needed with just the data set that is relevant to the reports, which is a considerably smaller data set. Obviously this has the down side of not being "live" data but I can live with that. Ultimately what I want to do is gather the relevant data from the linked table and save it to separate database that is local to the client so that it could be used if offsite/offline and to increase the speed of the report.
network location stored database = DB1 (Tabled linked to AS/400)
local client stored database = DB2 (relevant data set created by below SQL, non-linked tables named the same as the linked tables)
Below is the SQL statement that I'm trying to get to work using VBA & DAO
SELECT
DB1_TABLEA.FIELD1,
DB1_TABLEA.FIELD2,
DB1_TABLEA.FIELD3,
DB1_TABLEA.FIELD4,
DB1_TABLEA.FIELD5,
DB1_TABLEA.FIELD6,
DB1_TABLEA.FIELD7,
DB1_TABLEA.FIELD8
INTO
DB1_TABLEA IN 'Local_DB_Copy.accdb' <== Creating non-linked copy
FROM
DB1_TABLEA
WHERE
(
((DB1_TABLEA.FIELD4) Like 99999)
AND
((DB1_TABLEA.FIELD6)="02" Or (DB1_TABLEA.FIELD6)="22")
)
;
I already have my program working fine and returning/processing data from the AS/400 DB. I just need to be able to get the above to work so that people have the option to run a local copy that will process much faster.
Below is the code that I tried, but of course it fails or I wouldn't be here.
Sub gCreateLocalDBTables()
Dim DBPath As String
Dim LocalDBPath As String
Dim sSQL As String
Dim DB As DAO.Database
Dim DB2 As DAO.Database
Dim RS As DAO.Recordset
LocalDBPath = "AS400_Local.accdb"
sSQL = "SELECT DB1_TABLEA.FIELD1, DB1_TABLEA.FIELD2, DB1_TABLEA.FIELD3, DB1_TABLEA.FIELD4, DB1_TABLEA.FIELD5, DB1_TABLEA.FIELD6, DB1_TABLEA.FIELD7, DB1_TABLEA.FIELD8 INTO DB2_TABLEA IN '" & LocalDBPath & "' FROM DB1_TABLEA WHERE (((DB1_TABLEA.FIELD4) Like 99999) AND ((DB1_TABLEA.FIELD6)='02' Or (DB1_TABLEA.FIELD6)='22'));"
Set DB = OpenDatabase(LocalDBPath, False, False)
DB.TableDefs.Delete ("DB2_TABLEA")
DB.Close
DBPath = Interaction.GetSetting("Cust_Tools", "Settings\Report_Planning", "400DB_Location")
Set DB2 = OpenDatabase(DBPath, False, False)
Set RS = DB2.OpenRecordset(sSQL)
RS.Close
DB2.Close
Set RS = Nothing
Set DB = Nothing
Set DB2 = Nothing
End Sub
I know the SQL works as I have tested it from inside MS Access. I just can't find info on how to get it to work being passed from Excel VBA
You cannot assign an action query like a make-table query (i.e., SELECT with INTO call) to a recordset. Consider executing your DROP and SELECT ... INTO action queries prior to opening recordset on the local table. Also, it is unclear why you are opening a second database or what the path points to. Below opens a recordset on the mainframe data:
Set DB = OpenDatabase(LocalDBPath, False, False)
DB.Execute "DROP TABLE DB2_TABLEA", dbFailOnError
DB.Execute sSQL, dbFailOnError
Set RS = DB.OpenRecordset("SELECT * FROM DB2_TABLEA")
Furthermore, the IN clause in your make-table query is unnecessary as you are currently connected to the very database you are running the action on. Simply remove it ('" & LocalDBPath & "'). Also, LIKE expressions without wildcards and on numbers should be replaced with =
SELECT
DB1_TABLEA.FIELD1,
DB1_TABLEA.FIELD2,
DB1_TABLEA.FIELD3,
DB1_TABLEA.FIELD4,
DB1_TABLEA.FIELD5,
DB1_TABLEA.FIELD6,
DB1_TABLEA.FIELD7,
DB1_TABLEA.FIELD8
INTO
DB2_TABLEA
FROM
DB1_TABLEA
WHERE
(
((DB1_TABLEA.FIELD4) = 99999)
AND
((DB1_TABLEA.FIELD6)='02' OR (DB1_TABLEA.FIELD6)='22')
)
;
In fact, consider saving the query inside the MS Access database (Ribbon -> Create -> Query Design -> SQL View) and call it as a named object and avoid any long SQL in VBA.
DB.Execute "DROP TABLE DB2_TABLEA", dbFailOnError
DB.Execute "mySavedQuery", dbFailOnError
Set RS = DB.OpenRecordset("SELECT * FROM DB2_TABLEA")
I have one master db and slave dbs. I would like to sync those database, but two tables make lots of troubles.
By using an SQL Query, I get an error, because I used multi-valued fields. I cannot change the data structure and therefore I decided to "manually" loop through the recordsets and sync the tables. My code looks like this:
sub UpdateTable()...
.....
Dim rstSlave, rstMaster as DAO.Recordset
Dim fld as DAO.Field
Set dbSlave = currentDB
Set dbMaster = OpenDatabse("C:\Users\MyFile\Master_DB.accdb")
Set rstSlave = dbSlave.OpenRecordset("tbl_Candidate")
Set rstMaster = dbMaster.OpenRecordset("tbl_Candidate")
Set rstSlave = dbSlave.OpenRecordset("tbl_Candidate")
rstSlave.MoveFirst
While Not rstSlave.EOF
rstMaster.MoveFirst
Do While Not rstMaster.EOF
If rstMaster![ID] = rstSlave![ID] Then GoTo nextRecord
rstMaster.MoveNext
Loop
With rstMaster
.AddNew
For Each fld in .Fields
strFieldName = fld.Name
fld.Value = rstSlave.Fields(strFieldName).Value
Next fld
.Update
End With
nextRecord:
rstSlave.MoveNext
Wend
rstSlave.Close
rstMaster.Close
Set rstSlave = Nothing
Set rstMaster = Nothing
I cannot see the record in the master db. When debugging, I see that the ID of the record which was supposed to be transferred to the master db, already existed. Still couldn't find it in the master db when I opened the file.
Strangely it works the other way around. If I change something on the master db and sync it, I can see the changes on my slavedb.
If I have a query that I have created using VBA:
dim SQL as string
dim rs as recordset
dim db as database
SQL = "SELECT ... FROM ..."
Set db = CurrentDb
Set rs = db.OpenRecordset(SQL, dbOpenDynaset)
At the end of my sub I would always do the following:
rs.close
set rs = nothing
My question is, do I need to SQL ="" or something of that like? I think my confusion originally came from the fact that I haven't used set SQL in my code.
and if I do clear these strings, then, is there a 'best' way?
Since you're not opening a connection to either CurrentDb or the SQL string, there's no need to close them. However, you are opening a recordset, so that should be closed. It wouldn't harm anything to set SQL = "", but it's not going to actually do anything constructive.
As far as a "best way", I think you've already got it. At the end of your sub, or before any code that might prematurely exit it, just put:
rs.close
set rs = nothing
I have an Access database with a linked table in a second database, located in the same directory as the first.
I would like to copy the whole directory to a new location (for testing) and have database one still link to the table in database two, but the linkage is still to the original directory, not the new location.
I'd like to do one of two things: either
Make the link to the table in database two in such a way that the folder path is relative - that the path to database two isn't hardcoded.
or
Have a routine in Form_Load (or an autoexec macro) that checks the application.path and programmatically adjusts the linkage accordingly.
Thanks,
I used it succesfull, however did not use it with the recordset.
Const LnkDataBase = "C:\NorthWind.mdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 1 Then 'Only relink linked tables
If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
dbs.TableDefs(strTable).RefreshLink
End If
End if
End If
Next tdf
End Sub
It can be useful to have a start-up form that allows you to browse for the back-end you want and a table of the tables that should be linked. You could iterate through the tables collection, but i think a list is slightly safer. After that, a little code is all that is needed, here is a snippet:
''Connection string with database password
strConnect = "MS Access;PWD=pw;DATABASE=" & Me.txtNewDataDirectory
Set rs = CurrentDb.OpenRecordset("Select TableName From LinkTables " _
& "WHERE TableType = 'LINK'")
Do While Not rs.EOF
''Check if the table is already linked, if it is, update the connection
''otherwise, link the table.
If IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & rs!TableName & "'")) Then
Set tdf = db.CreateTableDef(rs!TableName, dbAttachSavePWD, _
rs!TableName, strConnect)
db.TableDefs.Append tdf
Else
db.TableDefs(rs!TableName).Connect = strConnect
End If
db.TableDefs(rs!TableName).RefreshLink
rs.MoveNext
Loop
I used usncahill's solution and modified it for my own needs. I do not have enough reputation to vote up their solution, so if you like my additional code, please vote us both up.
I wanted a quick way to switch between two back-end databases, one containing live data and the other containing test data. So I modified the previously mentioned code as follows:
Private Sub ReplaceLink(oldLink As String, newLink As String)
Dim tbl As TableDef, db As Database
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, oldLink) > 0 Then
tbl.Connect = Replace(tbl.Connect, oldLink, newLink)
tbl.RefreshLink
End If
Next
End Sub
Public Function ConnectTestDB()
ReplaceLink "Data.accdb", "Test.accdb"
End Function
Public Function ConnectLiveDB()
ReplaceLink "Test.accdb", "Data.accdb"
End Function
Public Function TestDBSwitch()
Dim tbl As TableDef, db As Database
Dim wasData As Boolean
Dim wasTest As Boolean
wasData = False
wasTest = False
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, "JGFC Flooring Data") > 0 Then
wasData = True
ElseIf InStr(tbl.Connect, "JGFC Flooring Test") > 0 Then
wasTest = True
End If
Next
If wasData = True And wasTest = True Then
MsgBox "Data Mismatch. Both Test and Live Data are currently linked! Connecting all tables to Test database. To link to Live database, please run again.", , "Data Mismatch"
ConnectTestDB
ElseIf wasData = True Then
ConnectTestDB
MsgBox "You are now connected to the Test database.", , "Connection Changed"
ElseIf wasTest = True Then
ConnectLiveDB
MsgBox "You are now connected to the Live database.", , "Connection Changed"
End If
End Function
(The previous code assumes that both the Test and Live Data files are located in the same directory and the file name ends in Test and Data, but can be easily modified to other paths/filenames)
I call TestSwitchDB from a button in my front-end DB to quickly change between testing and production environments. My Access DB has user controls to switch between user environments, so when the admin user logs in to the front-end DB, I use the ConnectTestDB function directly to default the admin user to connect to the test DB. I likewise, use the ConnectLiveDB function when other users login to the front-end.
There is also a quick error detection in the TestSwitchDB function to tell me if there are a mix of connections to both environments prior to calling the switch function. If this error is recurrent, it could be a sign of other issues.
Our corporate IT changed the pathing our shared files from local to corporate, which necessitated redirecting all of our database tables. This would have a been pain, to delete and recreate all the links, especially with multiple different databases linked. I found this question but neither of the other answers worked well for me. The following is what I used. Note, this will take awhile with many tables as each update might take a few seconds.
Public Sub Fix_Table_Locations()
Dim tbl As TableDef, db As Database, strConnect As String
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, "Portion of connect string to change") > 0 Then
tbl.Connect = Replace(tbl.Connect, "Portion of connect string to change", "New portion of connect string")
tbl.RefreshLink
End If
Next
End Sub
You may be able to use a relative path depending on where the files are located. The default location where Access looks is in Documents (C:\Users\UserName\Documents). So if you enter .. then it will take you one folder up from Documents, which is the user's folder. For example if your database file will always be stored at
C:\Users\UserName\Access App\Access Database
Then you can enter "..\Access App\Database" as the relevant file location. Otherwise you have to use VBA. In my case the file/file folders may not always be in the same location, some users may store the files on their Google drive, while others may use My Documents or the desktop. I was able to use a function similar to what usncahill posted:
Sub relinkBackendDB()
Dim sFilePath As String
Dim connectionString As String
Dim tbl As TableDef
Dim db As Database
sFilePath = (Application.CurrentProject.Path & "\system\Dojo Boss Database.accdb")
connectionString = ("MS Access;PWD=MyPassword;DATABASE=" & sFilePath)
Set db = CurrentDb
For Each tbl In db.TableDefs
If Len(tbl.Connect) > 0 Then
'MsgBox tbl.Connect 'If you're getting errors, uncomment this to see connection string syntax
tbl.Connect = connectionString
tbl.RefreshLink
End If
Next
End Sub
I call this function via the on_load event procedure when my "Home" form loads up, so it gets called whenever the app is first loaded/opened. This way it will always look in the relevant file folder, no matter what the user name is.