Login or Sign Up to become a member!

Less Than Dot is a community of passionate IT professionals and enthusiasts dedicated to sharing technical knowledge, experience, and assistance. Inside you will find reference materials, interesting technical discussions, and expert tips and commentary. Once you register for an account you will have immediate access to the forums and all past articles and commentaries.

From Wiki

Example: Creating a new database with a database password and some properties

  Sub CreateNewDB()
  'Requires reference to the Microsoft DAO x.x Object Library
  
      Dim strFileName As String
      Dim strFileExists As String
      Dim strNewFileName As String
      Dim strPath As String
      Dim strTitle As String
      Dim ws As Workspace
      Dim db As Database
      Dim prp As DAO.Property
      Dim tdf As TableDef
      Dim i As Integer
      
      'Set up a workspace.
      Set ws = DBEngine.Workspaces(0)
      
      'The path for the new database.
      strPath = "C:\Docs\"
      
      'The name of the new database.
      strFileName = "LTD.mdb"
  
      'Does this database already exist?
      strFileExists = Dir(strPath & strFileName)
      
      If strFileExists <> "" Then
          'If so ...
          Do While strFileExists <> ""
              'Try another name
              i = i + 1
              strNewFileName = "LTD" & i & ".mdb"
              
              'Does the new name exist?
              strFileExists = Dir(strPath & strNewFileName)
              
              'Keep trying.
          Loop
          
          'Rename the existing database with the new name.
          Name strPath & strFileName As strPath & strNewFileName
      End If
      
      'Create the new database.
      Set db = ws.CreateDatabase(strPath & strFileName, dbLangGeneral)
      
      'This will be the application title.
      strTitle = "Less Than Dot"
      
      'Create properties in new database.
      With db
          'Get rid of Name AutoCorrect anti-features.
          Set prp = .CreateProperty("Perform Name AutoCorrect", dbLong, 0)
          .Properties.Append prp
          Set prp = .CreateProperty("Track Name AutoCorrect Info", _
              dbLong, 0)
          .Properties.Append prp
          
          'Add the application title.
          Set prp = .CreateProperty("AppTitle", dbText, strTitle)
          .Properties.Append prp
  
      End With
      
      'Export tables from the current database
      For Each tdf In CurrentDb.TableDefs
          If Left(tdf.Name, 4) <> "MSys" Then
              'MSysIMEXColumns and MSysIMEXSpecs contain Import Export 
              'specifications export these if you wish to transfer 
              'specifications
              DoCmd.TransferDatabase acExport, "Microsoft Access", strPath _
                 & strFileName, acTable, tdf.Name, tdf.Name
          End If
      Next
      
      'Tidy up.
      db.Close
      Set prp = Nothing
      Set db = Nothing
      ws.Close
      Set ws = Nothing
  
      'Add a password to the new database.
      CreateDBPassword "LTD", strPath & strFileName
  
  End Sub
  
  Function CreateDBPassword(ByVal Password As String, _
          ByVal Path As String) As Boolean
  'Requires reference to the Microsoft ADO Ext 2.5 for DDL 
  'and Security library
  'This code is copied from:
  'http://msdn2.microsoft.com/en-us/library/aa139961(office.10).aspx
  
      Dim objConn As ADODB.Connection
      Dim strAlterPassword As String
      On Error GoTo CreateDBPassword_Err
      ' Create the SQL string to initialize a database password.
       strAlterPassword = "ALTER DATABASE PASSWORD " & Password & " NULL;"
  
      ' Open the unsecured database.
      Set objConn = New ADODB.Connection
      With objConn
          .Mode = adModeShareExclusive
          .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
              "Source= " & Path & ";"
  
       ' Execute the SQL statement to secure the database.
       .Execute (strAlterPassword)
      End With
  
      ' Clean up objects.
      objConn.Close
      Set objConn = Nothing
      
      ' Return true if successful.
      CreateDBPassword = True
      
  ExitHere:
      Exit Function
      
  CreateDBPassword_Err:
      MsgBox Err.Number & ":" & Err.Description
      CreateDBPassword = False
  End Function

Further Information

http://forum.dev.lessthandot.com/viewtopic.php?f=95&t=576&p=3036

Workspace.CreateDatabase Method: http://msdn2.microsoft.com/en-us/library/bb243161.aspx

Exploring Microsoft Access Security: http://msdn2.microsoft.com/en-us/library/aa139961(office.10).aspx