JRO Compact / Repair -------------------------------------------------------------------------------- Version 3.51 of the DAO library had a separate .Repair and .Compact methods, but these have been combined in DAO 3.6 into the .Compact method as can be seen from one sentence on this MS Knowledge base (ADO) article: ADO Compact / Repair. Using JRO, you can only compact an Access 2000 and above format. If you compact an Access 97 version, it will be converted to Access 2000 format. If you try to use the Jet 3.51 provider, it will not work and produces an error. You HAVE to use DAO to compact Access 97 databases, unless you want to convert them. If you are following the ADO tutorial, run the project and click on the "Compact / Repair" button. Use the Common Dialog to open the "TestDAOvsADO.mdb" database and proceed with the compaction. The next stage is to examine the Schema of the database Private Sub cmdADOCompact_Click() 'As we are using a Graphical Style Checkbox to simulate a Command button: If ChangeCmdProperties(cmdADOCompact) Then Exit Sub End If Dim JRO As New JRO.JetEngine Dim cnnSrc As New ADODB.Connection Dim strSource As String Dim strDestDB As String Dim strPassword As String Dim fAccess97 As Boolean Dim iFileStart As Integer Dim cTimer As clsTimer Dim tl As Long With cdlgFile .DialogTitle = "Select Database to Compact" .Filter = "Access 97/2000 (*.mdb)|*.mdb" .CancelError = False .InitDir = "C:\My Documents" .ShowOpen End With strSource = cdlgFile.FileName If strSource = "" Then MsgBox "Cancel clicked" Exit Sub End If 'open the database to get its version. Error if not Access97 fAccess97 = True On Error GoTo VersionErr cnnSrc.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & strSource & ";Persist Security Info=False" cnnSrc.Open ' Set the current connection to nothing before compacting cnnSrc.Close 'get path/file name of source, add "Backup of " to file name iFileStart = InStrRev(strSource, "\", , vbTextCompare) strDestDB = Mid$(strSource, 1, iFileStart) & "Backup of " & Mid$(strSource, iFileStart + 1) On Error GoTo CompactErr If fAccess97 Then 'This should work in theory, but comes up with an error. 'If you use Microsoft.Jet.OLEDB.4.0 it will work, but converts it to Access 2000 format 'Useful eh! Good old ADO... 'Time to go for DAO if using Access 97 databases! If MsgBox("You are about to try compacting an Access 97 database using JRO" & vbCrLf & _ "If you use OLEDB.4.0 it will convert to Access 2000 format." & vbCrLf & _ "Would you like to continue and receive an error message?", vbQuestion + vbYesNo) = vbYes Then Set cTimer = New clsTimer cTimer.Reset On Error GoTo CompactErr JRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & strSource & ";Jet OLEDB:Database Password=" & strPassword, _ "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & strDestDB & ";Jet OLEDB:Database Password=" & strPassword Else Set JRO = Nothing Exit Sub End If Else Set cTimer = New clsTimer cTimer.Reset JRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strSource & ";Jet OLEDB:Database Password=" & strPassword, _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDestDB & ";Jet OLEDB:Database Password=" & strPassword End If 'compact success so delete original file Kill strSource DoEvents 'rename backup to original name Name strDestDB As strSource MsgBox strSource & vbCrLf & "Compacted Successfully" tl = cTimer.Interval Me.Caption = "Time taken " & tl & " ms" Set cTimer = Nothing Set JRO = Nothing Exit Sub VersionErr: If Err.Number = -2147467259 Then cnnSrc.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strSource & ";Persist Security Info=False" fAccess97 = False Resume ElseIf Err.Number = -2147217843 Then 'wrong password strPassword = InputBox("Enter password for this database. Leave blank to Cancel") If strPassword = "" Then Exit Sub Else cnnSrc.Properties("Jet OLEDB:database Password").Value = strPassword Resume End If Else MsgBox "Error opening database: " & vbCrLf & strSource & vbCrLf & Err.Number & " " & Err.Description End If Exit Sub CompactErr: MsgBox strSource & vbCrLf & "Compact Error:" & vbCrLf & Err.Number & " " & Err.Description Set cTimer = Nothing End Sub |