Just paste this code into any class and change the name of the class to cDBPassword.
'----------------------------------------------------------------------
'
' Module Name: cDBPassword
' Written By: C&D Programming Corp.
' Create Date: 3/99
' Copyright: Copyright 1998-99 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
'
Option Explicit
Public DatabasePassword As String
Public DatabaseName As String
Public msUsername As String
Public msPassword As String
Public msWorkspaceName As String
Public meWorkspaceType As WorkspaceTypeEnum
Private mwrkDB As Workspace
Public Property Get WorkspaceName() As String
WorkspaceName = msWorkspaceName
End Property
Public Property Let WorkspaceName(sWorkspaceName As String)
CloseWorkspace
msWorkspaceName = sWorkspaceName
End Property
Public Property Get Username() As String
Username = msUsername
End Property
Public Property Let Username(sUsername As String)
CloseWorkspace
msUsername = sUsername
End Property
Public Property Get Password() As String
Password = msPassword
End Property
Public Property Let Password(sPassword As String)
CloseWorkspace
msPassword = sPassword
End Property
Public Property Get WorkspaceType() As WorkspaceTypeEnum
WorkspaceType = meWorkspaceType
End Property
Public Property Let WorkspaceType(sWorkspaceType As WorkspaceTypeEnum)
CloseWorkspace
meWorkspaceType = sWorkspaceType
End Property
'
' This should be set before anything else is used in this class.
'
Public Property Let SystemDatabase(sSystemDatabase As String)
' Check for database existence
If Dir(sSystemDatabase) = "" Then
Err.Raise 53, "SystemDatabase", "Could not locate " & sSystemDatabase
End If
DBEngine.SystemDB = sSystemDatabase
End Property
Private Sub CheckWorkspace()
If mwrkDB Is Nothing Then
Set mwrkDB = DBEngine.CreateWorkspace(WorkspaceName, Username, Password, WorkspaceType)
End If
End Sub
Private Sub CloseWorkspace()
If Not mwrkDB Is Nothing Then
Set mwrkDB = Nothing
End If
End Sub
'
' Can return error 3204 - Database already exists if you call this when the database already
' was created.
'
Public Sub CreateDatabase()
On Error GoTo Handler
CheckWorkspace
If DatabasePassword <> "" Then
Call mwrkDB.CreateDatabase(DatabaseName, dbLangGeneral & ";pwd=" & DatabasePassword, dbVersion30 Or dbEncrypt)
Else
Call mwrkDB.CreateDatabase(DatabaseName, dbLangGeneral, dbVersion30)
End If
Exit Sub
Handler:
Err.Raise Err.Number, "CreateDatabase", Err.Description
End Sub
Public Function OpenDatabase() As Database
On Error GoTo Handler
Set OpenDatabase = Nothing
CheckWorkspace
' Check for database existence
If Dir(DatabaseName) = "" Then
CreateDatabase
Else
' always open in shared mode and not readonly
If DatabasePassword <> "" Then
Set OpenDatabase = mwrkDB.OpenDatabase(DatabaseName, False, False, "MS Access;pwd=" & DatabasePassword)
Else
Set OpenDatabase = mwrkDB.OpenDatabase(DatabaseName, False, False)
End If
End If
Exit Function
Handler:
Err.Raise Err.Number, "OpenDatabase", Err.Description
End Function
Private Sub Class_Initialize()
Set mwrkDB = Nothing
WorkspaceName = "DBPassword"
WorkspaceType = dbUseJet
End Sub