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
| 
1701886
