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!

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

Open & CompactOnClose password-protected public db w/o passwrd prompts

Status
Not open for further replies.

dlcksc

Programmer
Feb 18, 2008
4
US
Access 2000:
Goal: to open a password-protected public access db (which compacts on close) and hide the password prompt on open and on close.

Purpose: Provide public access to Main.mde and protect Main.mde from remote connections, i.e, import & link.

I have password protected "Main.mde". Main.mde compacts on close.

If I open Main.mde directly, I'm prompted for the password on open but not on close, so I created Open.mde to open Main.mde and supply the password on open.

When I open it from "Open.mde" and supply the password with vba, Main.mde opens without prompting for a password, so I'm half way there.

But when Main.mde is closed (having been opened from Open.mde) the password prompt displays.

If I remove the "compact on close" setting in Main.mde, the prompt on close does not display, but I really need this db to compact on close.

So, I can avoid the prompt on close with the direct method, or I can avoid the prompt on open with the remote method, but I can't avoid both the open & close prompts with a single method.

Question: Is there a way to provide the password from Open.mde for both the open & close of Main.mde, or perhaps, another way to accomplish my goal? I believe the compact on close process includes exporting objects to a blank db, therefore, info on how to export from a password-protected db and automatically supply the database password, may also help me. Thank You.

Here is the code I'm using from Open.mde to open Main.mde.

Code:
    Dim Errnum As Long
    Dim ErrMsg As String
    On Error GoTo ErrorHandler
    
    Dim cRes As String, ourPath
    Dim nPos As Long
    cRes = CurrentDb.Name
    nPos = Len(cRes)
    
    'Find the current path
    Do Until Right(cRes, 1) = "\"
        nPos = nPos - 1
        cRes = Left(cRes, nPos)
    Loop
    
    ourPath = cRes
    'MsgBox ourPath
   
    Dim stPath As String, stDBName As String
    stDBName = "Main.mde"
    stPath = ourPath & stDBName
    'MsgBox stPath

    Dim wrk As Workspace
    Dim dbProtected As Database
    
    'Define as Static so the instance of Access doesn't close when the procedure ends.
    Static acc As Access.Application
    Dim db As DAO.Database
    Set acc = New Access.Application
    acc.Visible = True
    Set db = acc.DBEngine.OpenDatabase(stPath, False, False, ";PWD=PASSWORD")
    acc.OpenCurrentDatabase stPath
    db.Close
    Set db = Nothing
    
    Dim stFileName
    stFileName = "Main.ldb"
    stPath = ourPath & stFileName
    
    Dim fso As Scripting.FileSystemObject, xExistingFile As String
    Set fso = New Scripting.FileSystemObject
    
    xExistingFile = stPath
    
    'Loop here while Main.mde is open so I can Quit and keep
    'the user from manually having to close the instance
    While fso.FileExists(xExistingFile) = True
        DoEvents
    Wend
    
    DoCmd.Quit
 
Solution:
See below within the While loop... and I removed the "Compact & Repair on Close" from Main.mde & then modified my code a bit because the actual purpose for the compact on close is to make sure Main.mde doesn't exceed 500 megabytes. See below. This works like a charm. This function is called from the autoexec in Open.mde to open and monitor Main.mde. While Main.ldb exists, the size of Main.mde is monitored. If Main.mde exceeds 500 megabytes, it compacts and closes, then it reopens at the main menu. When Main.mde is closed (from it's main menu button), Open.mde Quits also along with the instance. It would be pretty tough, now, to break the security of Main.mde. Not only is it an mde (rather than an mdb), but it's also password-protected. So, if someone trys to import or link even the tables (which the mde will allow), they'll have to enter the database password! If you now of a more secure method, PLEASE let me know about it. Thank You.

Code:
Public Function Open_Protected_db()

    Dim Errnum As Long
    Dim ErrMsg As String
    On Error GoTo ErrorHandler
    
    Dim cRes As String, OpenPath
    Dim nPos As Long
    cRes = CurrentDb.Name
    nPos = Len(cRes)
    
    'Find the path of Open.mde
    Do Until Right(cRes, 1) = "\"
        nPos = nPos - 1
        cRes = Left(cRes, nPos)
    Loop
    
    OpenPath = cRes
    'MsgBox OpenPath
   
    Dim stPath As String, stDBName As String, stCopyPath As String
    stDBName = "Main.mde"
    stPath = OpenPath & stDBName
    'MsgBox stPath
    stCopyPath = OpenPath & "SBC_1.mde"
    'MsgBox stCopyPath

    Dim wrk As Workspace
    Dim dbProtected As Database
    
    'Define as Static so the instance of Access doesn't completely lose focus until the Quit
    Static AccInstance As Access.Application
    Dim db As DAO.Database
    Set AccInstance = New Access.Application
    AccInstance.Visible = True
    Set db = AccInstance.DBEngine.OpenDatabase(stPath, False, False, ";PWD=PASSWORD")
    AccInstance.OpenCurrentDatabase stPath
    db.Close
    Set db = Nothing
    
    Dim stFileName, ldbPath
    stFileName = "Main.ldb"
    ldbPath = OpenPath & stFileName
    
    Dim fso As Scripting.FileSystemObject, Main_ldb As String
    Set fso = New Scripting.FileSystemObject
    
    Main_ldb = ldbPath
    
    'While Main.ldb exists, Main.mde must be running, therefore, monitor the size of Main.mde
    While fso.FileExists(Main_ldb) = True
        If FileLen(OpenPath & "Main.mde") > 500000000 Then '500 megabytes
[b]            AccInstance.CloseCurrentDatabase
            Set AccInstance = Nothing [/b]
            MsgBox "The size of the database has exceeded 500 megabytes.  It will now automatically close (and then re-open) to perform a routine ""Compact & Repair"" to ensure proper performance and prevent database corruption."
[b]            DBEngine.CompactDatabase stPath, stCopyPath, , , ";pwd=PASSWORD"
            Kill stPath                  'delete Main.mde
            FileCopy stCopyPath, stPath  'copy Main_1.mde to Main.mde
            Kill stCopyPath              'delete Main_1.mde
[/b]            
            'Re-open Main.mde
            Set AccInstance = New Access.Application
            AccInstance.Visible = True
            Set db = AccInstance.DBEngine.OpenDatabase(stPath, False, False, ";PWD=PASSWORD")
            AccInstance.OpenCurrentDatabase stPath
            db.Close
            Set db = Nothing
        End If
    Wend

    DoCmd.Quit
    
    GoTo EndOfOpen_Protected_db

ErrorHandler:
    Errnum = Err
    ErrMsg = DLookup("[Description]", "tbl_Errors", "[Error Number] =" & Errnum)
    MsgBox ErrMsg
    
    Resume Next
    
EndOfOpen_Protected_db:
    
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top