[VB6/VB.NET] การ Compact และ Repair ไฟล์ฐานข้อมูล MS Access

thongkorn · โพสต์ 2019-2-12 11:38:58

การใช้ฐานข้อมูล MS Access เมื่อเราใช้ไปสักระยะ ไฟล์ข้อมูลก็มักจะมีขนาดใหญ่โตขึ้นไปเรื่อยๆ ซึ่งอาจเป็นเพราะข้อมูลขยะหรือเกิดความผิดพลาด รวมไปถึงการจับจองพื้นที่ในการใช้งานด้วย ดังนั้นเราจึงต้องทำการบีบอัด (Compact) และซ่อมแซม (Repair) ไฟล์อย่างเป็นประจำ เพื่อป้องกันปัญหาที่อาจจะเกิดขึ้นในอนาคต สำหรับในการเขียนโปรแกรมด้วย VB6 และ VB.NET เราจำเป็นต้องใช้งาน Microsoft Jet and Replication Objects (JRO) ดังนั้นเราต้อง Add References เข้ามาก่อนการใช้งานด้วย ...

หลักการคิด ...
(1) เลือกไฟล์ MS Access เข้ามา
(2) เปลี่ยนชื่อไฟล์ MS Access เป็นชื่ออื่นก่อน เช่น RepairDB
(3) ทำการ Compact ไฟล์ พร้อมๆกับการทำสำเนา (Copy) และใช้ชื่อไฟล์ต้นฉบับ JRO.CompactDatabase(SourceConnection:=, Destconnection:=)
(4) ลบไฟล์ที่เปลี่ยนชื่อใหม่ในข้อ 2 ทิ้งไป

Add Reference สำหรับ VB6

Add Reference สำหรับ VB.NET (COM)

มาดูโค้ดของ VB6 ...

' / --------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / MORE: http://www.g2gnet.com/webboard
' /
' / Purpose: Compact and Repair MS Access DataBase with VB6.
' / Microsoft Visual Basic 6.0 + MS Access
' /
' / This is open source code under @CopyLeft by Thongkorn/Common Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------
Option Explicit
Private Sub cmdBrowse_Click()
On Error Resume Next
dlgDatabase.InitDir = App.Path
dlgDatabase.DialogTitle = " Compact and Repair database" ' Set the Common Dialog Title
dlgDatabase.Filter = "Microsoft Access Database (*.MDB) | *.MDB" ' Display only MDB files
dlgDatabase.CancelError = False ' Cancel all errors
dlgDatabase.ShowOpen ' Show Open Dialog
dlgDatabase.DefaultExt = "*.MDB" ' Set the default extension
txtFilePath = dlgDatabase.FileName ' Put the selected filename in the textbox
If txtFilePath.Text <> "" Then cmdCompactRepair.Enabled = True
End Sub
Private Sub cmdBrowse_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Or KeyCode = vbKeyRight Then SendKeys "{TAB}"
If KeyCode = vbKeyUp Or KeyCode = vbKeyLeft Then SendKeys "+{TAB}"
End Sub
Private Sub cmdCompactRepair_Click()
'On Error Resume Next
On Error GoTo ErrHandler
Dim JRO As New JRO.JetEngine
Dim xFile As String ' To capture the DIR return string
Dim strPassword As String
'// Put the password.
strPassword = ""
xFile = Dir(App.Path & "\RepairedDB.mdb") '/ See if the TempPath already exists
If xFile <> "" Then Kill App.Path & "\RepairedDB.mdb" '/ Check if the Temp file already exists
' เริ่มการ Compact
JRO.CompactDatabase _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txtFilePath.Text & ";Jet OLEDB:Database Password=" & strPassword, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\RepairedDB.MDB" & ";Jet OLEDB:Database Password=" & strPassword
'//
cmdCompactRepair.Enabled = False
cmdExit.Enabled = False
'// Kill the original DB
Kill txtFilePath
'// Rename the Repaired DB with the Original DB Name
Name App.Path & "\RepairedDB.mdb" As txtFilePath
cmdCompactRepair.Enabled = True
cmdExit.Enabled = True
MsgBox "ทำการซ่อมแซมไฟล์ฐานข้อมูลเรียบร้อยแล้ว", vbOKOnly + vbInformation, "รายงานสถานะ"
'Unload Me
ExitProc:
Exit Sub
ErrHandler:
If Err.Number = -2147217843 Or Left$(Err.Description, 20) = "Not a valid password" Then
MsgBox "มีรหัสผ่านป้องกันไฟล์ฐานข้อมูล หรือ รหัสผ่านไม่ถูกต้อง.", vbOKOnly + vbCritical, "ต้องการรหัสผ่าน - Password"
Resume ExitProc
ElseIf Err.Number = -2147467259 Then
MsgBox "มีการเปิดไฟล์ฐานข้อมูล MS Access ค้างไว้ กรุณาปิดไฟล์ข้อมูลก่อนใช้งานด้วย.", vbOKOnly + vbCritical, "รายงานความผิดพลาด"
Resume ExitProc
Else
MsgBox "Compact Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "รายงานความผิดพลาด"
Resume ExitProc
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
txtFilePath.Text = ""
If txtFilePath.Text = "" Then cmdCompactRepair.Visible = False
End Sub
Private Sub txtFilePath_Change()
If txtFilePath = "" Then
cmdCompactRepair.Visible = False
Else
cmdCompactRepair.Visible = True
End If
End Sub
Private Sub txtFilePath_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then SendKeys "{TAB}"
If KeyCode = vbKeyUp Then SendKeys "+{TAB}"
End Sub
Private Sub txtFilePath_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub txtFilePath_LostFocus()
If txtFilePath = "" Then
cmdCompactRepair.Enabled = False
Else
cmdCompactRepair.Enabled = True
End If
End Sub

คัดลอกไปที่คลิปบอร์ด

มาดูโค้ดของ VB.NET ...

#Region "ABOUT"
' / --------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / MORE: http://www.g2gnet.com/webboard
' /
' / Purpose: Compact and Repair MS Access DataBase with VB.NET (2010).
' / Microsoft Visual Basic .NET (2010) + MS Access
' /
' / This is open source code under @CopyLeft by Thongkorn/Common Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------
#End Region
Imports System.IO
Public Class frmCompact
'// Data Path
Dim DataPath As String = String.Empty
' / --------------------------------------------------------------------------------
' / Get my project path
' / AppPath = C:\My Project\bin\debug
' / Replace "\bin\debug" with ""
' / Return : C:\My Project\
Function MyPath(AppPath As String) As String
'/ MessageBox.Show(AppPath);
AppPath = AppPath.ToLower()
'/ Return Value
MyPath = AppPath.Replace("\bin\debug", "").Replace("\bin\release", "").Replace("\bin\x86\debug", "")
'// If not found folder then put the \ (BackSlash) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
End Function
' / --------------------------------------------------------------------------
' / Browse the MS Access and check File in use or not?
Private Sub btnBrowse_Click(sender As System.Object, e As System.EventArgs) Handles btnBrowse.Click
Dim OpenFile As New OpenFileDialog()
' Specify the initial path, where I select the current project location.
OpenFile.InitialDirectory = MyPath(Application.StartupPath)
OpenFile.FileName = ""
' Set to select only filter (MS Access file) (* .accdb)
OpenFile.Filter = "Microsoft Access (*.accdb)|*.accdb"
' http://msdn.microsoft.com/en-us/library/c7ykbedk.aspx
' http://msdn.microsoft.com/en-us/library/system.windows.forms.dialogresult.aspx
Dim Res As System.Windows.Forms.DialogResult = OpenFile.ShowDialog()
'/ Press to cancel to exit sub.
If Res = System.Windows.Forms.DialogResult.Cancel Then Return
'// Check if the MS Access file is open or not.
If FileInUse(OpenFile.FileName) Then
MessageBox.Show("MS Access file is open, please close the file first.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Sub
End If
' Path and file names are displayed in the TextBox.
txtMDBLocation.Text = OpenFile.FileName
' Path only
Dim Fi As New FileInfo(OpenFile.FileName)
DataPath = Fi.Directory.ToString
'// If you select root folder it must have \ (Backslash) ... "C:"
'// Others not have \ (Backslash) ... "C:\Data"
If Microsoft.VisualBasic.Right(DataPath, 1) <> "" Then DataPath = DataPath & ""
End Sub
' / --------------------------------------------------------------------------
' / Check File in use or open.
Public Function FileInUse(ByVal sFile As String) As Boolean
FileInUse = False
If System.IO.File.Exists(sFile) Then
Try
Using F As New IO.FileStream(sFile, FileMode.Open, FileAccess.ReadWrite, FileShare.None)
'// FileInUse = False
End Using
Catch
FileInUse = True
End Try
End If
End Function
' / --------------------------------------------------------------------------
' / Compact & Repair MS Access DataBase.
Private Sub btnCompact_Click(sender As System.Object, e As System.EventArgs) Handles btnCompact.Click
'// Check the file exist.
If txtMDBLocation.Text <> "" AndAlso File.Exists(txtMDBLocation.Text) Then
Try
'// If File exists, delete it.
If File.Exists(DataPath & "RepairDB.accdb") Then My.Computer.FileSystem.DeleteFile(DataPath & "RepairDB.accdb")
My.Computer.FileSystem.RenameFile(txtMDBLocation.Text, "RepairDB.accdb")
Dim JRO As New JRO.JetEngine
''/ Ref: https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/bb237197(v=office.12)
' Format
'JRO.CompactDatabase(SourceConnection:=, Destconnection:=)
JRO.CompactDatabase( _
"Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DataPath & "RepairDB.accdb", _
"Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & txtMDBLocation.Text & ";Jet OLEDB:Engine Type=5" & _
";Jet OLEDB:Database Password=")
My.Computer.FileSystem.DeleteFile(DataPath & "RepairDB.accdb")
'//
MessageBox.Show("Compact & Repair MS Access Successfully.")
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End If
End Sub
Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
Me.Close()
End Sub
Private Sub frmCompact_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Me.Dispose()
Application.Exit()
End Sub
End Class

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดต้นฉบับ VB6 และ VB.NET (2010) ได้ที่นี่ ...

		จำสถานะนี้ไว้ในครั้งหน้า	ลืมรหัสผ่าน
รหัสผ่าน			ลงทะเบียน

[VB6/VB.NET] การ Compact และ Repair ไฟล์ฐานข้อมูล MS Access

ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง