Switchboard Building

[Mksmall]

Is it possible to build a switchboard to open different databases?. We have several seperate databases that we would like to create a central access point, but can it be done in a switchboard? If not, can it be done another way?

 

[grtammi]

Hi Mksmall...

You can use a switchboard to open another database with no problem...instead of populating a list box, you'll want to set each individual switchboard option to the name of the database...modify the code for the DblClick event to your command button's On_Click event.

'Run this code when the form loads - it will populate the list box on the form

Private Sub Form_Load()

      'declare database, recordset, table name and SQL variables
    Dim dbs As Database, rst As Recordset, strSQL As String, strTblName As String
    Dim I 'general count variable for loop below
    
    Set dbs = CurrentDb
    strTblName = "tblDatabaseListing"
        
    'Delete the old table, if it exits
    On Error Resume Next
    dbs.TableDefs.Delete strTblName
    
    'Generate an empty Database name table in calling database
    strSQL = "CREATE TABLE " & strTblName & "(DbName TEXT (40));"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    
    'Now we need to fill the table - first, create a reference to the table
    Set rst = dbs.OpenRecordset(strTblName)
    
    With Application.FileSearch
        .NewSearch
        .LookIn = "L:\"
        .FileType = msoFileTypeDatabases
        If .Execute > 0 Then
            For I = 1 To .FoundFiles.count
                rst.AddNew
                rst!DbName = .FoundFiles(I)
                rst.Update
            Next I
        Else
            MsgBox "No database files found", vbInformation, "No Database Files Located"
            Exit Sub
        End If
    End With
    
    lstDatabases.RowSourceType = "Table/Query"
    lstDatabases.RowSource = strTblName
    
    rst.Close
    dbs.Close
    
End Sub

The listbox DblClick event

Private Sub lstDatabases_DblClick(Cancel As Integer)
    
    Dim strDbName
    Dim appAccess As Access.Application
    strDbName = lstDatabases.Column(0)
    Set appAccess = CreateObject("Access.Application.8")
    appAccess.OpenCurrentDatabase strDbName
    appAccess.Visible = True
    
End Sub

Hope this helps...if you have any questions, feel free to contact me at the e-mail address below.

Greg Tammi, ATS Alarm Supervisor
E-mail: gtammi@atsbell.com

 

[Mksmall]

As I understand it, I need to create individual command buttons on the form for each database. But I'm confused as to why I then need a list box on the form.

 

[Mksmall]

I have been able to get the first section of code to work by changing the .LookIn to my drive and file location. The form will pull in the databases in that location. Now....when I double clicked any database I received an "error 429". I click debug and the 4th line of the second section of code was highlighted. Since I'm running Access 2000, I changed it to "Access.Application.9". Was this correct? Now if I double click, the database will very quickly open then close. Any ideas??

 

[grtammi]

Heh...I'm having that same problem also.

I can make the db stay open, but the minute I attempt to perform any action, the db closes...

Stay tuned, I'm working on a solution as we speak (type?)..

 

[grtammi]

Ok, think I've got it...

Take this line: Dim appAccess as Access.Application and put it in the global declaration area of the module (right below the Option Compare Database and Option Explicit statements).

HTH

Greg

 

[Mksmall]

I beleive I have it working. I placed the Dim appAccess as Access.Application as you stated. But it still ran the same. Opened quickly then closed. I then removed the same statement from the Dblclick event and it worked. Where ever I have the first section pointed...It will show those databases in the form and open them.

YOU DA'MAN

Thanks

 

[grtammi]

No problem.

 

[GeekGirlau]

I have a central database from which I launch multiple others, but it uses Shell instead. It's the equivalent of creating a shortcut for the database and just using Start, Run to launch it.

The table "tblDatabase" contains the name of the project, a descriptive name for the database, the name and path of the.mdb file, and the full path of the .mdw file if there is one. The path for the MSAccess.exe file is also recorded, as this is required when you try to use Shell when you have a .mdw file.

The project and descriptive database name are displayed in a list box. The user can right click to edit the properties, which allows them to change the paths. When the user double-clicks, the following code runs:

CODE SAMPLE:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub lstDatabase_DblClick(Cancel As Integer)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strAccess As String
Dim strLaunch As String
Dim strFile As String
Dim x


On Error GoTo LaunchErr

strSQL = "SELECT * FROM tblDatabase WHERE ID=" & Me.lstDatabase

strAccess = DLookup("[strAccessPath]", "tblSYSConfiguration&quot

If Dir(strAccess, vbNormal) = "" Then
MsgBox "The path for MSAccess.exe is incorrect - cannot launch Access!" & vbCrLf & _
vbCrLf & "Click on the 'Access Path' button to set the location.", vbCritical, _
"Cannot Locate MSAccess.exe"

DoCmd.OpenForm "frmSYSConfiguration", acNormal, , , acFormEdit
GoTo ExitLaunch
End If

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

With rs
strFile = !strPath & !strDBFile

If Dir(strFile, vbNormal) = "" Then
MsgBox "The path for this database is incorrect - cannot launch the database!" & _
vbCrLf & vbCrLf & "Right-click the mouse on the database and select " & _
"'Database Properties' to set the location.", _
vbCritical, "Cannot Locate Database"

GoTo ExitLaunch
End If

strLaunch = Chr(34) & strAccess & Chr(34)
strLaunch = strLaunch & " " & Chr(34) & strFile & Chr(34)

If Not IsNull(!strWorkGroup) Then
strLaunch = strLaunch & " /wrkgrp " & Chr(34) & !strWorkGroup & Chr(34)
End If
End With

x = Shell(strLaunch, vbMaximizedFocus)


ExitLaunch:
On Error Resume Next
rs.Close
db.Close

Exit Sub


LaunchErr:
MsgBox err.Number & ": " & err.Description
Resume ExitLaunch
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

It's really simple to use and edit, and just launches your existing database without having to create a new one.

 

[grtammi]

yep, that'll work too...