Compact a JET database using ADO in VB6

By -
The following routines demonstrates how to compact a JET database using ADO:

Option Explicit

'Purpose     :  Compact a JET (Access) database using ADO
'Inputs      :  sDatabasePath                   The path to the database path eg. C:\nwind.mdb
'               [bEncryptDatabase]              If True, encrypts the contents of the database
'Outputs     :  Returns zero if successful, else returns error code
'Notes       :  Requires "Microsoft Jet and Replication Objects X.X library",
'               where (X.X is greater than or equal to 2.1)
'               Compacts the database by creating a temporary database with the extension .tmp then,
'               if the compaction is successful, it overwrites the original database.
'               Will not work if anyone else is connected to the database.
'Revisions   :
'Assumptions :

Function DatabaseCompact(sDatabasePath As String, Optional bEncryptDatabase As Boolean = False) As Long
    Dim oJRO As Object 'JRO.JetEngine

    On Error GoTo ErrFailed
    
    If Len(Dir$(sDatabasePath & ".tmp")) Then
        'Delete the existing temp database
        VBA.Kill sDatabasePath & ".tmp"
    End If
    
    Set oJRO = CreateObject("JRO.JetEngine")
    
    If bEncryptDatabase Then
        'Compact and encrypt the database
        oJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath & ".tmp;Jet OLEDB:Encrypt Database=True"
    Else
        'Compact the database
        oJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath & ".tmp;Jet OLEDB:Engine Type=4"
    End If
    
    'Delete the existing database
    VBA.Kill sDatabasePath
    'Rename the compacted database
    Name sDatabasePath & ".tmp" As sDatabasePath
    Set oJRO = Nothing

    Exit Function

ErrFailed:
    Debug.Print "Failed to compact database: " & Err.Description
    DatabaseCompact = Err.Number
    Set oJRO = Nothing
    On Error GoTo 0
End Function

'Demonstration routine
Sub Test()
    Dim lRes As Long
    On Error Resume Next
    lRes = DatabaseCompact("C:\test.mdb", True)
    If lRes = 0 Then
        MsgBox "Succeeded in compacting database...", vbInformation
    Else
        'Show error message
        MsgBox Error(lRes)
    End If
    Exit Sub
ErrFailed:
    MsgBox Err.Description
End Sub

Comments

Post a Comment

Popular posts from this blog

How to Create a Configuration.INI Files in VB6

By -
Image
In this example shows only a simple form that saves and retrieves value from the CONFIG.INI file. After reading this, you can use your own creativity on how you're going to implement this on your project. To start with, On your Form add the following controls and arrange them according to the image above. (1) TextBox - Change the Name property to "txtSetting" (2) Command Button - Change the Caption and Name Properties to the following:                                        Save:          Change the Name property to "cmdSave"                                        Retrieve:    Change the Name property to "cmdRetrieve" (5) Label - For the two labels we'll be using to retrieve the values. Remove the default caption and change...
Read More »

How to Set Windows Form Always on Top of Other Applications in VB6

By -
The following code snippets allows to set Windows Form Always on Top of Other applications in Visual Basic 6.0. Public Const SWP_NOMOVE = 2 Public Const SWP_NOSIZE = 1 Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE Public Const HWND_TOPMOST = -1 Public Const HWND_NOTOPMOST = -2 Declare Function SetWindowPos Lib "user32" _ (ByVal hWnd As Long, _ ByVal hWndInsertAfter As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal cx As Long, _ ByVal cy As Long, _ ByVal wFlags As Long) As Long The following SetTopMostWindow() function takes two parameters as follows:       hWnd : the window handle       Topmost : It is either True to set the on top or False if Not. Public Function SetTopMostWindow(hWnd As Long, Topmost As Boolean) As Long If Topmost = True Then 'Make the window topmost SetTopMostWindow = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS) Else SetTopMostWindow = SetWindowPos(hW...
Read More »

How to Minimize/Send an App Icon to System Tray in Visual Basic 6

By -
The following code snippet allows to manipulate the system tray by adding your apps icon when you minimize the form and restore when you double click on the app's icon on the system tray area. Option Explicit Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String * 64 End Type Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const WM_MOUSEMOVE = &H200 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Const WM_LBUTTONDBLCLK = &H203 'Double-click Public Const WM_LBUTTONDOWN = &H201 'Button down Public Const WM_LBUTTONUP = &H202 'Button up Public Const WM_RBUTTONDBLCLK = &H206 'Double-click Public Const WM_RBUTTONDOWN = &H204 'Button down Public Const WM_RBUTTONUP = &H205 'Button up Public Declare Function Shel...
Read More »