Cara Merepair & Compact Database Ms.Access

'***************************************************************
' CompactAndRepairDB (FUNCTION)
'
' PARAMETERS:
' sSource - Path untuk source database
' sDestination - Path untuk destination database
' sSecurity - Path untuk Jet system database jika ada
' sUser - username jika level keamanan tersedia
' sPassword - password
' lDestinationVersion - versi database yang digunakan
' version dibutuhkan; 1 = Jet 1.0,
' 2 = Jet 1.1, 3 = Jet 2.x,
' 4 = Jet 3.x, 5 = Jet 4.x etc
'
' Nilai yg dikembalikan:
' True - jika sukses
'
' CATATAN:
' Program ini membutuhkan penambahan referensi dari
' Microsoft Jet and Replication Objects 2.x
' Anda bis memilih Project » References » Microsoft Jet
' And Replication Object 2.x Library
'***************************************************************

Public Function CompactAndRepairDB(sSource As String, _
sDestination As String, _
Optional sSecurity As String, _
Optional sUser As String = "Admin", _
Optional sPassword As String, _
Optional lDestinationVersion As Long) As Boolean

Dim sCompactPart1 As String
Dim sCompactPart2 As String
Dim oJet As JRO.JetEngine

sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
";Data Source=" & sSource & _
";User Id=" & sUser & _
";Password=" & sPassword

If sSecurity <> "" Then
sCompactPart1 = sCompactPart1 & _
";Jet OLEDB:System database=" & sSecurity & ";"
End If

sCompactPart2 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
";Data Source=" & sDestination

' versi jet:
' 1 = Jet 1.0, 2 = Jet 1.1, 3 = Jet 2.x, 4 = Jet 3.x,
' 5 = Jet 4.x etc
If lDestinationVersion <> 0 Then
sCompactPart2 = sCompactPart2 & _
";Jet OLEDB:Engine Type=" & lDestinationVersion
End If

' Compact dan repair database
Set oJet = New JRO.JetEngine
oJet.CompactDatabase sCompactPart1, sCompactPart2
Set oJet = Nothing
CompactAndRepairDB = True
End Function

Private Sub Command1_Click()
CompactAndRepairDB "C:\db1.mdb", "C:\baru.mdb"
End Sub