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:
DoCmd.OpenForm "Switchboard", acNormal
DoCmd.Maximize
DoCmd.Close acForm, "ECD Splash Screen"
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