Launch password protected database and close existing one - ms-access

Question

I am trying to set up a "Launcher" database which contains VBA code that will open a second database which is password protected. I can then convert the launcher db to accde so the VBA containing the password cannot be read.
I have the following code so far.
Private Sub Form_Load()
Dim acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
strDbName = "C:\database Folder\secureDB.accdb"
Set acc = New Access.Application
acc.Visible = True
Set db = acc.DBEngine.OpenDatabase(strDbName, False, False, ";PWD=swordfish")
acc.OpenCurrentDatabase (strDbName)
Application.Quit
End Sub
When the launcher db is opened a form loads which subsequently fires the above code. It works but the problem is the last line which is intended to close the launcher db only but closes both databases. I have also tried opening the main database using Shell but am unable to pass the password this way.
How can I close the first database while keeping the second open?

Answer 1

You can use the following:
Private Sub Form_Load()
Dim acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
strDbName = "C:\database Folder\secureDB.accdb"
Set acc = New Access.Application
acc.Visible = True
acc.OpenCurrentDatabase strDbName, False, "swordfish"
Set db = acc.CurrentDb() 'Don't know why you want a reference to the db
acc.UserControl = True
Application.Quit
End Sub
The relevant part is acc.UserControl = True, that forces the DB to stay visible and stops it from closing as soon as the reference to the Application object gets destroyed.
A sample database that stores the main database password encrypted with a salted user password can be found in this answer

Answer 2

I was having trouble getting the accepted answer to work properly. I was able to make work with:
Public Function OpenAccessDb(strVerPath, strFileName, sRecordset, strPwd)
'You may also need to have the following References Added:
'Microsoft Access 16.0 Object Library & Microsoft Office 16.0 Access Database Engine Object
'Visual Basic for Applications// Microsoft Excel 16.0 Object Library// OLE Automation//
'Microsoft Forms 2.0 Object Library// Microsoft Outlook 16.0 Object Library// Microsoft Office 16.0 Object Library
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
Dim sPath As String
'sPath = GetProperDirectory(strVerPath, strFileName) ' you can bypass this function by setting the path manually below and commenting this out.
sPath = "C:\database Folder\secureDB.accdb"'manually set the path here and comment out line above
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath, False, True, "MS Access;PWD=" & strPwd)
Set oRS = oDB.OpenRecordset(sRecordset)
''paste to call this function
''note this function utilizes the GetProperDirectory function.
''The GetProperDirectory function uses xxxxx as the location source
''therefore the strVerPath should start after \xxxxx\yyyyyy\yyyyy\DB.accdb
'strVerPath = "\yyyyyy\yyyyy\"
'strFileName= "DB.accdb"
'sRecordSet= "table in access DB" 'the table you are sending the data to
'strPwd = "password' 'this is the password that allows access to the database
'booOpenSend= OpenAccessDb(strVerPath, strFileName, sRecordSet, strPwd)
''end paste
End Function