2010年6月28日 星期一

EXCEL VBA壓縮ACCESS資料庫(版本2003)

先在【專案】【設定引用項目】中加入 Microsoft Jet and Replication Objects X.X library

有密碼的版本
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txt1.Text & ";Jet OLEDB:Database Password=" & txt2.Text, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txt3.Text & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password=" & txt4.Text
壓縮時,可同時改MDB的密碼


Public Sub CompactJetDatabase()
Dim ret

ret = MsgBox("請問是否進行資料壓縮?", vbYesNo, "資料庫壓縮")


If ret = vbNo Then
Exit Sub
End If


Dim SelDB As String
Dim SelDB2 As String
SelDB = ThisWorkbook.Path & "\" & "A1.mdb"
SelDB2 = ThisWorkbook.Path & "\" & "A2.mdb"



Dim jro As jro.JetEngine
Set jro = New jro.JetEngine

'引擎版本號
'Jet OLEDB:Engine Type -> Jet x.x Format MDB Files
'1 -> JET10
'2 -> JET11
'3 -> JET2X
'4 -> JET3X
'5 -> JET4X

jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & A1 , "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & A2 & ";Jet OLEDB:Engine Type=5"

Kill A1 '刪除舊的
Name A2 As A1 '變更名稱

MsgBox "壓縮/修復 成功!"




End Sub

沒有留言:

張貼留言

追蹤者