'tambahkan referensi Microsoft Jet and Replication Objects 2.6 Library
'sebaiknya jangan mencoba langsung ke database yang asli, karna kalo salah
bisa kehapus file .mdbnya, jadi file .mdbnya dibackup dulu
Private Function CompactAndRepairDB(ByVal sSource As String, ByVal
sDestination As String, Optional ByVal Password As String = "") As Boolean
On Error Resume Next
Dim sCompactPart1 As String
Dim sCompactPart2 As String
Dim oJet As JRO.JetEngine
If Trim$(Password) <> "" Then
sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" &
sSource & ";Jet OLEDB:Database Password=" & Password & ""
Else
sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" &
sSource & ""
End If
If Trim$(Password) <> "" Then
sCompactPart2 = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" &
sDestination & ";Jet OLEDB:Database Password=" & Password & ""
Else
sCompactPart2 = "Provider=Microsoft.Jet.OLEDB.4.0" & ";Data Source=" &
sDestination & ""
End If
' Compact and repair the database
Set oJet = New JRO.JetEngine
Call oJet.CompactDatabase(sCompactPart1, sCompactPart2)
Set oJet = Nothing
CompactAndRepairDB = True
End Function
Private Function FileExists(strNamaFile As String) As Boolean
If Dir$(strNamaFile, vbNormal) = "" Then
FileExists = False
Else
FileExists = True
End If
End Function
Private Sub Form_Load()
If CompactAndRepairDB(App.Path & "\MyDB.mdb", App.Path & "\NEW_MyDb.mdb") =
True Then
If FileExists(App.Path & "\MyDB.mdb") Then Kill (App.Path & "\MyDB.mdb")
DoEvents
If FileExists(App.Path & "\NEW_MyDb.mdb") Then Name App.Path &
"\NEW_MyDb.mdb" As App.Path & "\MyDB.mdb"
End If
End Sub
Cak Don <[EMAIL PROTECTED]> wrote:
rekan2, mau tanya nich, di MS Access kan ada menu Tool->Database
Utilities -> Compact dan Repair Database..
nah.. bagaimana syntak di VB6 untuk menjalankan tool "Compact dan
Repair Database" pada database MS.Access.
terima kasih atas pencerahan nya
salam
cak don
---------------------------------
Get the Yahoo! toolbar and be alerted to new email wherever you're surfing.
[Non-text portions of this message have been removed]
