Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Database Opens very slowly

Status
Not open for further replies.
mcelligott

mcelligott

Programmer
Apr 17, 2002
135
US
Hello all,

I have the following code which executes when each person opens the database. It is located in the "On Open" event of the splash screen that first appears when opening. Because we are a 24/7 operation and the information in the database is CRITICAL, I have built redundancy into the opening of it.

The problem is that for some reason it is slowing down the opening of the database. What use to take only a 3-5 seconds, now takes as much as 1 minute.

Here is the way it is suppose to work: On opening, check to see if the backend is available on the main file server. If it is, is the first table showing linked to that backend. If it is, do nothing more. Just show the Splash screen and then the switchboard. I am getting the impression it is doing a lot more than it is suppose to.

Any thoughts or ideas would be greatly appreciated.

Bob

Code: 
Private Sub Form_Open(Cancel As Integer)

Dim strServerPath As String 'path to server
Dim strAltServerPath As String 'path to alternate ECD server
Dim strVPNPath As String 'path to ECD server via VPN connection
Dim strMCUPath As String 'path to MCU server
Dim strLocalPath As String  'path to local workstation
Dim strGFDPath As String 'path to Gates FD
Dim strPerintonPath As String 'path to Perinton Ambulance
Dim FSO 'File System Object
Dim response As String

Set FSO = CreateObject("scripting.filesystemobject")

strServerPath = "\\Ecd911\911\Database\Operations Database\ECD Operations Database_be.mdb"
strAltServerPath = "\\fd01map\alternate server\ECD Operations Database_be.mdb"
strVPNPath = "\\10.100.91.3\database$\operations database\ECD Operations Database_be.mdb"
strMCUPath = "\\abernas\operations database\ECD Operations Database_be.mdb"
strGFDPath = "\\Dispatch_2\operations\ECD Operations Database_be.mdb"
strPerintonPath = "o:\ecd\ECD Operations Database_be.mdb"
strLocalPath = "c:\operations\ECD Operations Database_be.mdb"

If FSO.FileExists(strServerPath) = True Then
   Call pfECDServerReLink
ElseIf FSO.FileExists(strMCUPath) = True Then
   Call pfMCUReLink
ElseIf FSO.FileExists(strGFDPath) = True Then
   Call pfGFDReLink
ElseIf FSO.FileExists(strAltServerPath) = True Then
   Call pfAltServerReLink
ElseIf FSO.FileExists(strVPNPath) = True Then
   Call pfVPNRelink
ElseIf FSO.FileExists(strPerintonPath) = True Then
   Call pfPerintonReLink
Else
   Call pfLocalReLink
End If

lastline:
End Sub
---------------------------------------------------------
Function pfECDServerReLink()

Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim firsttbl As TableDef
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs
Set firsttbl = dbs.TableDefs("Alarm Companies")

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "MCU"
         Call pfMCUUser
    Case Is = "GatesFD"
        Call pfGatesFDUser
End Select

'Determines if the table Alarm Companies is already connected to the ECD Server
If firsttbl.Connect = ";Database=" & "\\Ecd911\911\Database\Operations Database\ECD Operations Database_be.mdb" Then
    GoTo lastline
End If

'Loop through the tables collection and relinks to the ECD server if not already connected
MsgBox "Reconnecting to the ECD Server, this will take a few minutes.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
         Tdf.Connect = ";Database=" & "\\Ecd911\911\Database\Operations Database\ECD Operations Database_be.mdb"
         Tdf.RefreshLink
    End If
Next

lastline:
End Function
--------------------------------------------------------
Function pfAltServerReLink()
Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "MCU"
         Call pfMCUUser
    Case Is = "GatesFD"
        Call pfGatesFDUser
End Select

'Determines if the table Alarm Companies is already connected to the ECD Server
If firsttbl.Connect = ";Database=" & "\\fd01map\Operations\ECD Operations Database_be.mdb" Then
    GoTo lastline
End If

'Loop through the tables collection and relinks to FD01 mapping computer if not already connected
MsgBox "The ECD Server is unavailable, connecting to the FD01 mapping computer.  This will take a few minutes.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
        Tdf.Connect = ";Database=" & "\\fd01map\operations\ECD Operations Database_be.mdb"
        Tdf.RefreshLink
    End If
Next

lastline:
End Function
----------------------------------------------------------
Function pfVPNRelink()

Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim firsttbl As TableDef
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs
Set firsttbl = dbs.TableDefs("Alarm Companies")

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "MCU"
         Call pfMCUUser
    Case Is = "GatesFD"
        Call pfGatesFDUser
End Select

'Determines if the table Alarm Companies is already connected to the ECD Server via VPN
If firsttbl.Connect = ";Database=" & "\\10.100.91.3\Database$\Operations Database\ECD Operations Database_be.mdb" Then
    GoTo lastline
End If

'Loop through the tables collection and relinks to ECD via VPN if not already connected
MsgBox "Connecting to the ECD Server via VPN.  This will take a few minutes.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
        Tdf.Connect = ";Database=" & "\\10.100.91.3\database$\operations database\ECD Operations Database_be.mdb"
        Tdf.RefreshLink
    End If
Next

lastline:
End Function
---------------------------------------------------------
Function pfGFDReLink()

Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim firsttbl As TableDef
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs
Set firsttbl = dbs.TableDefs("Alarm Companies")

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "MCU"
         Call pfMCUUser
End Select

'Determines if the table Alarm Companies is already connected to the Gates FD
If firsttbl.Connect = ";Database=" & "\\Dispatch_2\Operations\ECD Operations Database_be.mdb" Then
    GoTo lastline
End If

'Loop through the tables collection and relinks to the Gates FD if not already connected
MsgBox "Reconnecting to the Gates FD, this will take a few minutes.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
         Tdf.Connect = ";Database=" & "\\Dispatch_2\Operations\ECD Operations Database_be.mdb"
         Tdf.RefreshLink
    End If
Next

lastline:
End Function
-----------------------------------------------------
Function pfPerintonReLink()

Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim firsttbl As TableDef
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs
Set firsttbl = dbs.TableDefs("Alarm Companies")

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "MCU"
         Call pfMCUUser
    Case Is = "GatesFD"
        Call pfGatesFDUser
End Select

'Determines if the table Alarm Companies is already connected to Perinton
If firsttbl.Connect = ";Database=" & "o:\Ecd\ECD Operations Database_be.mdb" Then
    GoTo lastline
End If

'Loop through the tables collection and relinks to Perinton if not already connected
MsgBox "Reconnecting to Perinton, this will take a few minutes.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
         Tdf.Connect = ";Database=" & "o:\Ecd\ECD Operations Database_be.mdb"
         Tdf.RefreshLink
    End If
Next

lastline:
End Function
-----------------------------------------------------
Function pfLocalReLink()
Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "MCU"
         Call pfMCUUser
    Case Is = "GatesFD"
        Call pfGatesFDUser
End Select

'Loop through the tables collection
MsgBox "No networks were found, connecting to the your computer.  This data may not be as up-to-date.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
        Tdf.Connect = ";Database=" & "C:\Operations\ECD Operations Database_be.mdb"
        Tdf.RefreshLink
    End If
Next

lastline:
End Function
-----------------------------------------------------
Function pfMCUReLink()

Dim dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim firsttbl As TableDef
Set dbs = CurrentDb
Set Tdfs = dbs.TableDefs
Set firsttbl = dbs.TableDefs("Alarm Companies")

'Determines if the current user is a special use or regular sign on
Select Case CurrentUser()
    Case Is = "GatesFD"
        Call pfGatesFDUser
End Select

'Determines if the table Alarm Companies is already connected to the MCU Server
If firsttbl.Connect = ";Database=" & "\\Abernas\Operations Database\ECD Operations Database_be.mdb" Then
    GoTo lastline
End If

'Loop through the tables collection and relinks to MCU if not already connected
MsgBox "The ECD Server is unavailable, connecting to the MCU server.  This will take a few minutes.  Sorry for the inconvenience.", vbInformation
For Each Tdf In Tdfs
    If Tdf.SourceTableName <> "" Then
        Tdf.Connect = ";Database=" & "\\Abernas\operations database\ECD Operations Database_be.mdb"
        Tdf.RefreshLink
    End If
Next

lastline:
End Function
 
Sort by date Sort by votes
On opening, check to see if the backend is available on the main file server. If it is, is the first table showing linked to that backend. If it is, do nothing more.
Click to expand...
Well not completely. What about when it does not find the linked back end? Then it does a lot more. It attempts to located the back end and then relinks the tables.

So here is some questions.
1)Is it dropping the backend every time forcing it to run the relink code? Easy test. Hold the Shift key and open the database to bypass the on open code. Check to see if you are linked.
2)Is the relinking code running slow? If 1 is true then do a manual relink.
 
Upvote 0 Downvote
Re: "Because we are a 24/7 operation and the information in the database is CRITICAL"

I'd stop worrying about a 55 second time delay and worry about moving the data to an enterprise quality database. SQL Server Express has these qualities and is free.

C
 
Upvote 0 Downvote
Stepping through the code should give you an idea what is happening.

My guess would be that this line in pfECDServerReLink (or the equivalent in one of the other "ReLink" subs) is always returning False, causing it to relink all the tables every time the database is opened:

Code: 
If firsttbl.Connect = ";Database=" & "\\Ecd911\911\Database\Operations Database\ECD Operations Database_be.mdb" Then
 
Upvote 0 Downvote
Thank you all for your replies. Sorry for the delay in getting back to you.

I have done a step by step process of elimination and found that the problem is occurring when I close the form "ECD Splash Screen". When the VBA code attempts to close the form, it takes quite awhile to close down.

This is the line I am using to close the form. It was located in the On Timer event but have since moved it to the end of the Form Open event.

Code: 
DoCmd.Close acForm, "ECD Splash Screen"

I am unsure what is happening in the background that is causing the delay. Any help would be greatly appreciated.

Thanks,

Bob
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Moss100
  • Locked
  • Question
Open New Access Database and Maximise the Application Window
Replies
0
Views
227
Moss100
Moss100
Moss100
  • Locked
  • Question
Make database appear as just a form
Replies
1
Views
105
dhookom
dhookom
aldi07
  • Locked
  • Question
update a front-end database with a new release using vba
Replies
5
Views
176
aldi07
aldi07
Sajjad668
  • Locked
  • Question
insert multiple image on single row in ms access database using vba
Replies
1
Views
103
dhookom
dhookom
Greg T
  • Locked
  • Question
Split database MDE TableDefs not saved
Replies
2
Views
49
Greg T
Greg T

Part and Inventory Search

Sponsor

Back
Top