Re: [belajar-access] Compact and repair data base

 

Ini kode untuk Compact and repair database Acc 2007 yang sedang tidak
dibuka. Bisa saya cek, kodenya masih menggunakan ActiveX, padahal bisa
menggunakan MSACCESS.EXE, misal:

'Tentukan lokasi MsAccess.Exe di PC Anda:

dim ms_access as string

ms_access = """C:\Program Files\Microsoft Office\Office12\MSACCESS.EXE"" "

strPath = ms_access & "D:\Opi\Database.accdb" & " /compact "

Call Shell(strPath, vbHide)

Namun Compact and repair database Acc 2007 yang sedang dibuka, tidak bisa
dilakukan. Kecuali untuk Acc selain 2007, maka bisa dilakukan.

Wassalaamu'alaikum Warahmatullahi Wabarakatuh,
Sofyan Efendi
http://imopi.wordpress.com | http://trendmuslim.com
----- Original Message -----
From: "access" <access_tea@yahoo.co.id>
To: <belajar-access@yahoogroups.com>
Sent: Wednesday, August 08, 2012 10:23 AM
Subject: [belajar-access] Compact and repair data base

> Assalamualaikum.....
> Selamat Pagi semuanya...
> Apa kabar ?
>
> Barusan saya browsing guna mencari coding untuk compact and repair
> access 2007 with VBA, ternyata malah mendapatkan seperti ini , sudi
> kiranya para master memberikan penjelasannya keapada saya ....
> koding nya seperti ini :
>
> Sub CompactDbase()
> ' Requires a reference to be set to
> ' "Microsoft Jet & Replication Objects Library 2.x"
> ' (Tools > References and check the reference)
> ' Requires a form called "startup" with a label called "ProgressLabel"
> On Error Goto ErrHandler
>
> ' Inform user of progress
> Form_StartUp.ProgressLabel.Caption = "Starting Process"
> DoEvents
>
> ' dimension variables and set
> Dim DbaseDir As String
> Dim BackupDir As String
> Dim DbaseName As String
> Dim DbaseTempName As String
> Dim DbaseBackupName As String
> Dim Dbasebk1 As String
> Dim Dbasebk2 As String
> Dim Dbasebk3 As String
> Dim Dbasebk4 As String
> Dim Dbasebk5 As String
>
> ' CHANGE SETTINGS IN THIS SECTION TO REUSE THIS PROGRAM
> ' ###########################################################
> DbaseDir = "C:\Database\"
> BackupDir = "C:\DbaseBackup\"
> DbaseName = "XXX.mdb"
> DbaseTempName = "XXXTemp.mdb"
> DbaseBackupName = "XXXBackup.mdb"
> Dbasebk1 = "XXX1.mdb"
> Dbasebk2 = "XXX2.mdb"
> Dbasebk3 = "XXX3.mdb"
> Dbasebk4 = "XXX4.mdb"
> Dbasebk5 = "XXX5.mdb"
> ' ###########################################################
> Form_StartUp.ProgressLabel.Caption = "Initial Backup started. " &
> DbaseBackupName
> DoEvents
> ' Perform Backup before starting
> FileCopy DbaseDir & DbaseName, _
> DbaseDir & DbaseBackupName
>
> Dim je As New JRO.JetEngine
>
> ' Kill previous Temp file
> If Dir(DbaseDir & DbaseTempName) <> "" Then _
> Kill DbaseDir & DbaseTempName
>
> ' Compact dbase to dbaseTemp
> Form_StartUp.ProgressLabel.Caption = "Compacting started. " &
> DbaseTempName
> DoEvents
> je.CompactDatabase _
> "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & DbaseDir & DbaseName, _
> "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & DbaseDir & DbaseTempName & ";"
>
> ' Delete dbase
> Form_StartUp.ProgressLabel.Caption = "Replacing compact file " &
> DbaseName
> DoEvents
> Kill DbaseDir & DbaseName
>
> ' Rename dbaseTemp (now compacted) to dbase
> Name DbaseDir & DbaseTempName _
> As DbaseDir & DbaseName
>
> ' Resuffle backups and backup current
> Form_StartUp.ProgressLabel.Caption = "Resuffling backups " & Dbasebk5
> DoEvents
> If Dir(BackupDir & Dbasebk5) <> "" Then
> Kill BackupDir & Dbasebk5
> End If
> Form_StartUp.ProgressLabel.Caption = "Resuffling backups " & Dbasebk4
> DoEvents
> If Dir(BackupDir & Dbasebk4) <> "" Then
> Name BackupDir & Dbasebk4 _
> As BackupDir & Dbasebk5
> End If
> Form_StartUp.ProgressLabel.Caption = "Resuffling backups " & Dbasebk3
> DoEvents
> If Dir(BackupDir & Dbasebk3) <> "" Then
> Name BackupDir & Dbasebk3 _
> As BackupDir & Dbasebk4
> End If
> Form_StartUp.ProgressLabel.Caption = "Resuffling backups " & Dbasebk2
> DoEvents
> If Dir(BackupDir & Dbasebk2) <> "" Then
> Name BackupDir & Dbasebk2 _
> As BackupDir & Dbasebk3
> End If
> Form_StartUp.ProgressLabel.Caption = "Resuffling backups " & Dbasebk1
> DoEvents
> If Dir(BackupDir & Dbasebk1) <> "" Then
> Name BackupDir & Dbasebk1 _
> As BackupDir & Dbasebk2
> End If
>
>
> FileCopy DbaseDir & DbaseName, _
> BackupDir & Dbasebk1
> Form_StartUp.ProgressLabel.Caption = "Process info"
> DoEvents
> Exit Sub
>
> ErrHandler:
> MsgBox ("Error message here - Your first time ? Did you forget to hold
> down shift key ?")
> End Sub
>
> Public Function CompactBackupdbase()
> ' Allows sub to be visible from macros
> Call CompactDbase
> End Function
>
>
>
> Terima kasih
>
>
>
> --
> Best regards,
> access
> mailto:access_tea@yahoo.co.id
>
>
>
> ------------------------------------
>
> SPAM IS PROHIBITEDYahoo! Groups Links
>
>
>

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (2)

Recent Activity:

• New Members 5

Visit Your Group

SPAM IS PROHIBITED

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___