OTWarrior
04-26-2010, 01:40 AM
I stumbled across this code, and thought I would share it with you guys
Source:
http://www.fmsinc.com/MicrosoftAccess/Performance/LinkedDatabase.html
Sub OpenAllDatabases(pfInit As Boolean)
' Open a handle to all databases and keep it open during the entire time the application runs.
' In: pfInit TRUE to initialize (call when application starts)
' FALSE to close (call when application ends)
' Created : FMS, Inc.
Dim x As Integer
Dim strName As String
Dim strMsg As String
' Maximum number of back end databases to link
Const cintMaxDatabases As Integer = 2
' List of databases kept in a static array so we can close them later
Static dbsOpen() As DAO.Database
If pfInit Then
ReDim dbsOpen(1 To cintMaxDatabases)
For x = 1 To cintMaxDatabases
' Specify your back end databases
Select Case x
Case 1:
strName = "H:\Dir\Backend1.mdb"
Case 2:
strName = "H:\Dir\Backend2.mdb"
End Select
strMsg = ""
On Error Resume Next
Set dbsOpen(x) = OpenDatabase(strName)
If Err.Number > 0 Then
strMsg = "Trouble opening database: " & strName & vbCrLf & _
"Make sure the drive is available." & vbCrLf & _
"Error: " & Err.Description & " (" & Err.Number & ")"
End If
On Error GoTo 0
If strMsg <> "" Then
MsgBox strMsg
Exit For
End If
Next x
Else
On Error Resume Next
For x = 1 To cintMaxDatabases
dbsOpen(x).Close
Next x
End If
End Sub
Source:
http://www.fmsinc.com/MicrosoftAccess/Performance/LinkedDatabase.html
Sub OpenAllDatabases(pfInit As Boolean)
' Open a handle to all databases and keep it open during the entire time the application runs.
' In: pfInit TRUE to initialize (call when application starts)
' FALSE to close (call when application ends)
' Created : FMS, Inc.
Dim x As Integer
Dim strName As String
Dim strMsg As String
' Maximum number of back end databases to link
Const cintMaxDatabases As Integer = 2
' List of databases kept in a static array so we can close them later
Static dbsOpen() As DAO.Database
If pfInit Then
ReDim dbsOpen(1 To cintMaxDatabases)
For x = 1 To cintMaxDatabases
' Specify your back end databases
Select Case x
Case 1:
strName = "H:\Dir\Backend1.mdb"
Case 2:
strName = "H:\Dir\Backend2.mdb"
End Select
strMsg = ""
On Error Resume Next
Set dbsOpen(x) = OpenDatabase(strName)
If Err.Number > 0 Then
strMsg = "Trouble opening database: " & strName & vbCrLf & _
"Make sure the drive is available." & vbCrLf & _
"Error: " & Err.Description & " (" & Err.Number & ")"
End If
On Error GoTo 0
If strMsg <> "" Then
MsgBox strMsg
Exit For
End If
Next x
Else
On Error Resume Next
For x = 1 To cintMaxDatabases
dbsOpen(x).Close
Next x
End If
End Sub