Option Compare Database
Option Explicit
'Significantly Improve the Performance of Microsoft Access Databases with Linked Tables
'Provided by: Luke Chung, FMS President
'A Split Microsoft Access Database Architecture Offers Many Advantages
'A split database architecture is best for developing, maintaining, and deploying Microsoft Access applications.
'The front-end database contains all the Access objects except the tables which reside in a separate back-end Access Jet database.
'The front-end database links to the tables in the back-end database, so it can be updated without worrying about changes to the data.
'
'Automate Microsoft Access Application DeploymentsThis is particularly important for multi-user applications where each user
'has a copy of the front-end database on their machine sharing the same centralized data.
'When the application is enhanced (new queries, forms, reports, code, etc.), it is simply distributed to each user.
'Programs like our Total Access Startup can centralize and automate the distribution process.
'If you are not familiar with a split database architecture, read our paper on Splitting Microsoft Access Databases
'to Improve Performance and Simplify Maintainability
'
'Microsoft Access Database with Linked Tables Sometimes Perform Poorly
'When a single database is converted to a split-database design, one sometimes sees significant performance degradation,
'especially over a network. Speed may vary with different portions of the application and number of users.
'Some people settle for this but there may be a simple way to significantly improve performance.
'
'Microsoft Access Lock Files
'When a database is opened, Microsoft Access creates a lock file on disk.
'You may see these are *.LDB or *.LACCDB files. When the database is closed, the lock file is deleted.
'This is not a big deal for a single MS Access database application which would create the lock file when the database is
'opened and maintain it until the database is closed. But in a linked database design, the lock file on the back-end database
'may be created and deleted every time a table is opened and closed.
'When no connections to any tables on the back end database remain open, the lock file is deleted. That takes time.
'Always Keep a Connection Open to the Back End Database While Your Application Runs
'You can significantly improve the performance of your Access database by maintaining an open connection to the back-end database
'throughout the time your front-end database is opened.
'By forcing Access to keep the linked table's database open, Access avoids creating a new lock on the backend database every time
'one of its tables is used. This lets you open tables, forms, and reports much faster.
'Over a network, you'll usually see a substantial improvement with how quickly a form opens when it's based on a linked table.
'The DAO OpenDatabase Method
'To create a persistent connection to the linked database, open a MS Access database variable in VBA using the DAO OpenDatabase method.
'Keep this variable open as long as your application is running.
'Procedure Code
'The procedure below supports multiple backend databases. Edit the section with the list of databases to match your backend database(s):
Function OpenAllDatabases(Optional pfInit As Boolean = True, Optional CheckStatusOnly As Boolean = False) As Boolean
' Open a handle to all databases and keep it open during the entire time the application runs.
' Params : pfInit TRUE to initialize (call when application starts)
' FALSE to close (call when application ends)
' Source : Total Visual SourceBook
Dim X As Integer
Dim strName As String
Dim strMsg As String
Dim BElist As String
' List of databases kept in a static array so we can close them later
Static dbsOpen() As DAO.Database
CheckIfOpened:
If CheckStatusOnly Then
On Error Resume Next
If UBound(dbsOpen) < 0 Then
OpenAllDatabases = False
Else
Err.Clear
For X = LBound(dbsOpen) To UBound(dbsOpen)
strName = dbsOpen(X).Name
Next X
If Err.Number > 0 Then
Err.Clear
OpenAllDatabases = False
Else
OpenAllDatabases = True
End If
End If
Exit Function
End If
'Getting a list with remote Back-end databases
BElist = ListBESources(True)
If BElist = "" Then Exit Function
If Right(BElist, 1) = ";" Then BElist = Left(BElist, Len(BElist) - 1)
' Maximum number of back end databases to link
' Const cintMaxDatabases As Integer = 9
OpenAllDatabases = True 'IN CASE OF ERROR WILL BECOME FALSE
OpenDatabases:
If pfInit Then
Debug.Print "Opening all Databases ...",
ReDim dbsOpen(LBound(Split(BElist, ";")) To UBound(Split(BElist, ";")))
On Error Resume Next
For X = LBound(dbsOpen) To UBound(dbsOpen)
strName = Split(BElist, ";")(X)
Debug.Print strName
If strName <> "" Then
If IsFile(strName) Then
Set dbsOpen(X) = OpenDatabase(strName, False, False, "MS Access;PWD=" & "")
If Err.Number > 0 Then OpenAllDatabases = False
Else
OpenAllDatabases = False
End If
End If
Next X
Else
ClosingDatabases:
Debug.Print "Closing Databases ...",
On Error Resume Next
For X = LBound(dbsOpen) To UBound(dbsOpen)
Err.Clear
Set dbsOpen(X) = Nothing
If Err.Number > 0 Then OpenAllDatabases = False
Next X
End If
Debug.Print "DONE."
End Function
'Invoking the Procedure
'
'Call this when your application starts:
'---------------------------------------------------------------------------
' OpenAllDatabases True
'
'When you finish, call this to close the database variables/handles:
'
' OpenAllDatabases False
'---------------------------------------------------------------------------
'For instance, if you have a form that controls the application and remains open during the entire time the user is using your database, add the code to the OnOpen and OnClose events.
'
'This simple technique yields considerable performance gains.
'---------------------------------------------------------------------------
'HELPER FUNCTIONS
'---------------------------------------------------------------------------
Function ListBESources(Optional RemoteOnly As Boolean = False) As String
''List Back-End Data Sources
Dim collTables As New Collection
On Error Resume Next
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strCon As String
Dim strBackEnd As String
Dim BE
Set db = CurrentDb
'Loop through the TableDefs Collection.
For Each tdf In db.TableDefs
'Ensure the table is a linked table.
If Len(tdf.Connect) > 0 Then
' If Left$(tdf.Connect, 10) = ";DATABASE=" Then
'Get the path/filename of the linked back-end
strBackEnd = Split(tdf.Connect, ";DATABASE=")(1)
' strBackEnd = Mid(tdf.Connect, 11)
'Ensure we have a valid string to add to our collection
If Len(strBackEnd & "") > 0 Then
collTables.Add Item:=strBackEnd, Key:=strBackEnd
End If
End If
Next tdf
On Error GoTo 0
Debug.Print collTables.Count & " Data Source(s) found:"
For Each BE In collTables
Select Case RemoteOnly
Case True
If b42_StripFolderFromPath(BE, "folder") <> CurrentProject.Path & "\" Then _
ListBESources = ListBESources & BE & ";"
Case False
ListBESources = BE & ";" & ListBESources
End Select
' ReturnUserRoster (BE)
' If PRINT_DEBUG_INFO And (Not isDBRT) Then Debug.Print ListBESources
Next BE
Set db = Nothing
End Function
Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
On Error Resume Next
IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
'If PRINT_DEBUG_INFO And (Not isDBRT) Then Debug.Print vbDirectory, GetAttr(fName)
On Error GoTo 0
End Function
Function b42_StripFolderFromPath(ByVal strFullPath As String, returnPart As String) As String
'Separates the path and filename in a full path
'the returnPart argument specifies the result you want:
'returnPart = "Folder" : will return the path to the file w/o the filename (w/o a backslash at the end)
'returnPart = "File" : will return the filename only with the extension
'however the argument will be disregarded if a backslash is not found in the string or is the last symbol
Dim SlashPos
SlashPos = InStr(1, StrReverse(strFullPath), "\")
If SlashPos = 0 Then b42_StripFolderFromPath = strFullPath
If SlashPos = 1 Then b42_StripFolderFromPath = Left(strFullPath, Len(strFullPath) - 1)
If SlashPos > 1 And returnPart = "Folder" Then _
b42_StripFolderFromPath = Left(strFullPath, Len(strFullPath) - SlashPos)
If SlashPos > 1 And returnPart = "File" Then _
b42_StripFolderFromPath = Right(strFullPath, SlashPos - 1)
End Function
