Consulting

Results 1 to 2 of 2

Thread: How to compact ACCDB (Access 2007) Database using VBA?

  1. #1

    How to compact ACCDB (Access 2007) Database using VBA?

    How to compact ACCDB (Access 2007) Database using VBA?

    Please help

  2. #2
    VBAX Master CreganTur's Avatar
    Joined
    Jan 2008
    Location
    Greensboro, NC
    Posts
    1,676
    Location
    You can accomplish this using ADO and a direct connection to the JET engine. The following example also deals with setting passwords an dopening databases. Just take what you need

    You'll need a reference (Tools->References) to the Microsoft ActiveX Data Objects library, and the Jet and Replication Objects Library.

    [VBA]
    Sub setPass_AndOpenDB_withADO()
    Dim jetEng As JRO.JetEngine
    Dim conn As ADODB.Connection
    Dim strCompactFrom As String
    Dim strCompactTo As String
    Dim strPath As String

    strPath = CurrentProject.Path & "\"

    strCompactFrom = "Northwind.mdb"
    strCompactTo = "Northwind_P.mdb"

    On Error GoTo ErrorHandler

    Set jetEng = New JRO.JetEngine

    ' Compact the database specifying
    ' the new database password
    jetEng.CompactDatabase "Data Source=" & _
    strPath & strCompactFrom & ";", _
    "Data Source=" & strPath & strCompactTo & ";" & _
    "Jet OLEDBatabase Password=welcome"

    MsgBox "The database file " & strPath & strCompactTo & _
    " has been protected with password."
    Set jetEng = Nothing

    ' now open the password-protected MDB database
    Set conn = New ADODB.Connection
    With conn
    .Provider = "Microsoft.Jet.OLEDB.4.0;"
    .ConnectionString = "Data Source=" & _
    strPath & strCompactTo & ";" & _
    "Jet OLEDBatabase Password=welcome;"
    .Open
    End With

    If conn.State = adStateOpen Then
    MsgBox "Password protected database was opened."
    End If

    conn.Close
    MsgBox "Password protected database was closed."

    Set conn = Nothing
    Exit Sub
    ErrorHandler:
    If Err.Number = -2147217897 Then
    Kill strPath & strCompactTo
    ElseIf Err.Number = -2147467259 Then
    MsgBox "Make sure to close the " & strCompactFrom & _
    " database file prior to compacting it."
    Exit Sub
    Else
    MsgBox Err.Number & ": " & Err.Description
    Exit Sub
    End If
    Resume
    End Sub
    [/VBA]
    -Randy Shea
    I'm a programmer, but I'm also pro-grammar!
    If your issue is resolved, please use Thread Tools to mark your thread as Solved!

    PODA (Professional Office Developers Association) | Certifiable | MOS: Access 2003


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •