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

Hatur nuhun pisan kang Sofyan, mudah mudahan ilmunya bertambah terus
amiiin...

SE>
SE>
SE>
SE>
SE> Ini kode untuk Compact and repair database Acc 2007 yang sedang tidak
SE> dibuka. Bisa saya cek, kodenya masih menggunakan ActiveX, padahal bisa
SE> menggunakan MSACCESS.EXE, misal:
SE>
SE> 'Tentukan lokasi MsAccess.Exe di PC Anda:
SE>
SE> dim ms_access as string
SE>
SE> ms_access = """C:\Program Files\Microsoft Office\Office12\MSACCESS.EXE"" "
SE>
SE> strPath = ms_access & "D:\Opi\Database.accdb" & " /compact "
SE>
SE> Call Shell(strPath, vbHide)
SE>
SE> Namun Compact and repair database Acc 2007 yang sedang dibuka, tidak bisa
SE> dilakukan. Kecuali untuk Acc selain 2007, maka bisa dilakukan.
SE>
SE> Wassalaamu'alaikum Warahmatullahi Wabarakatuh,
SE> Sofyan Efendi
SE> http://imopi.wordpress.com | http://trendmuslim.com
SE> ----- Original Message -----
SE> From: "access" <access_tea@yahoo.co.id>
SE> To: <belajar-access@yahoogroups.com>
SE> Sent: Wednesday, August 08, 2012 10:23 AM
SE> Subject: [belajar-access] Compact and repair data base
SE>
>> 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



SE>
SE>
SE>
SE>
SE>
SE>



--
Best regards,
access mailto:access_tea@yahoo.co.id



------------------------------------

SPAM IS PROHIBITEDYahoo! Groups Links

<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/belajar-access/

<*> Your email settings:
Individual Email | Traditional

<*> To change settings online go to:
http://groups.yahoo.com/group/belajar-access/join
(Yahoo! ID required)

<*> To change settings via email:
belajar-access-digest@yahoogroups.com
belajar-access-fullfeatured@yahoogroups.com

<*> To unsubscribe from this group, send an email to:
belajar-access-unsubscribe@yahoogroups.com

<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/