ขึ้นชื่อหัวเรื่องมาก็งงกันล่ะซิครับ ... พี่น้อง บางคนก็คงสงสัยว่าคนเขียนบทความมันบ้า (หรือเมา) เปล่าเนี่ย ทะลึ่งมาแนะนำการเขียนโปรแกรมอย่างไรให้มี Error 55555 ... เรื่องแบบนี้มันไม่ได้ปรากฏในหลักการ หรือ ทฤษฎีอย่างใดครับ ประมาณว่าคงต้องขุดหาเอากันล่ะครับ ... เอิ๊กๆๆๆๆๆ แต่ทว่าเราต้องนำมาใช้บ่อยครั้งกับระบบพวกไฟล์ โฟลเดอร์ ดิสต์ เหล่านี้ทั้งน้านเลย การทำงานในลักษณะนี้จะอาศัยการดักจับ Error ด้วยคำสั่ง On Error GoTo ... แล้วให้ไปตรวจสอบความผิดพลาดนั้นๆด้วย Err.Number หรือ Err.Description เราก็ทำการแก้ไขความผิดพลาดที่เราเจอะเจอให้เป็นที่เรียบร้อย จากนั้นก็สั่ง Resume เพื่อบังคับให้โปรแกรมกลับไปทำงานต่อยังจุดที่เกิดความผิดพลาดนั้นขึ้นมา ... Sub Program() On Error Goto ErrHandler คำสั่ง 1 คำสั่ง 2 ... ปรากฏว่ามี Error มันก็จะกระโดดไปทำงานยัง ErrHandler คำสั่ง 3
ExitProc: Exit Sub
ErrHandler: ' ตรวจสอบความผิดพลาด If Err.Number = ... Then ทำการแก้ไขความผิดพลาด ' การสั่ง Resume ก็คือบังคับให้มันกลับทำงานต่อจากคำสั่งที่เกิด Error ขึ้น นั่นคือมันจะกระโดดกลับไปทำงานยัง คำสั่งที่ 3 ต่อเลยครับ ... พี่น้อง Resume End If End Sub
Design
ต้องอ้างถึง ADO 2.8 และ MS Jet and Replication
Component
Option Explicit
Private Sub cmdBrowse_Click()
On Error Resume Next ' ไม่สน Error ใดๆทั้งสิ้น
dlgOpenFile.DialogTitle = " เลือกไฟล์ MS Access ที่ต้องการกระชับข้อมูล (Compact DataBase) " ' แสดง Title Bar
dlgOpenFile.Filter = "Microsoft Access Database (*.MDB) | *.MDB" ' เลือก (Filter) เฉพาะไฟล์ MDB
dlgOpenFile.ShowOpen ' เปิด Dialog ขึ้นมาเพื่อเลือกไฟล์
dlgOpenFile.CancelError = True ' ยกเลิกทุกๆความผิดพลาด ไม่สนว่างั้นเหอะ ... พี่น้อง
dlgOpenFile.DefaultExt = "*.MDB" ' ตั้งค่าเป็นมาตรฐานให้เลือกเฉพาะไฟล์ Access (นามสกุล MDB)
txtFilePath = dlgOpenFile.FileName ' เลือกไฟล์ได้แล้วก็ให้นำไปใส่ไว้ใน TextBox แบบ Full Path เลย
End Sub
Private Sub cmdCompact_Click()
' คอยดักความผิดพลาด - Trap Error
On Error GoTo ErrHandler
' ต้องอ้างถึง ADO 2.8 ด้วยน่ะครับ ... พี่น้อง เพื่อใช้ในการตรวจสอบรหัสผ่าน
Dim Conn As ADODB.Connection
Dim JRO As New JRO.JetEngine
Dim strTemp$ ' รับค่าตำแหน่งไฟล์
Dim strPassword As String ' รับรหัสผ่าน (หากมี)
strTemp = Dir(App.Path & "\RepairedDB.mdb") ' กำหนดไฟล์ชั่วคราวเพื่อไว้รับไฟล์ต้นฉบับ
If strTemp <> "" Then Kill App.Path & "\RepairedDB.mdb" ' หากมีของเดิมอยู่แล้วให้ลบทิ้งก่อน
' ทดสอบว่ามีรหัสผ่านหรือไม่
' หากไม่มีมันก็จะทำงานตามบรรทัดคำสั่งไปเรื่อยๆ จนกว่าจะจบโปรแกรมย่อย
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
" Data Source = " & txtFilePath.Text & ";" & _
";Jet OLEDB:Database Password="
' ไฟล์ที่ติดรหัสผ่านมันจะเกิด Error ที่ตรงนี้ จากนั้นมันก็กระโดดไปที่ลาเบล ErrHandler
' เนื่องมาจากบรรทัดคำสั่ง On Error GoTo ErrHandler ที่เราประกาศเอาไว้ยังด้านบน
Conn.Close: Set Conn = Nothing
'
' เมื่อได้รับรหัสผ่านมันก็จะกระโดดกลับมาทำงานต่อ ณ ตำแหน่งนี้ด้วยการสั่ง Resume มาจาก ErrHandler
' เริ่มการ 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
'
Kill txtFilePath ' ลบไฟล์ต้นฉบับออก
' แล้วเปลี่ยนชื่อไฟล์ชั่วคราว (ที่เรานำไป Compact) ให้เป็นชื่อไฟล์ต้นฉบับแทน
Name App.Path & "\RepairedDB.mdb" As txtFilePath
MsgBox "ทำการซ่อมแซมไฟล์ฐานข้อมูลเรียบร้อยแล้ว", vbOKOnly + vbInformation, "รายงานสถานะ"
Unload Me
ExitProc:
Exit Sub
ErrHandler:
' กรณีมีการตรวสอบความผิดพลาดหลายๆตัว ควรใช้ Select Case Err.Number น่าจะเหมาะกว่าน่ะครับ ... พี่น้อง
' Error นี้เราจะรู้ได้ไงล่ะ ... มันก็มาจากตอนที่ระบบมันฟ้องขึ้นมาน้านแหละครับพี่น้อง
If Err.Number = -2147217843 Or Left$(Err.Description, 20) = "Not a valid password" Then
MsgBox "มีรหัสผ่านป้องกันไฟล์ฐานข้อมูล หรือ รหัสผ่านไม่ถูกต้อง.", vbOKOnly + vbCritical, "ต้องการรหัสผ่าน - Password"
' รับค่า Password
strPassword = InputBox("กรุณาใส่รหัสผ่านของไฟล์ฐานข้อมูล MS Access ก่อนด้วย.", "ต้องการรหัสผ่าน")
' กรณีที่ต้องการใส่รหัสผ่านลงไปตายตัวเลย ก็ไม่ต้องทำคำสั่งด้านบนน่ะครับ แต่ ...
' ต้องแก้ไขอีกเล็กน้อย ... คิดว่าคงไม่ยากเย็นเกินไปนักหรอกครับ ... พี่น้อง
If strPassword = "" Then
Exit Sub ' หรือ Resume ExitProc
Else
Conn.Properties("Jet OLEDB:database Password").Value = strPassword
' เอ้า ... สั่งให้กลับไปทำงานต่อยังตำแหน่งที่เกิด Error ด้วยคำสั่ง Resume
Resume
End If
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_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF1: MsgBox "No help now."
Case vbKeyEscape:
cmdExit_Click
End Select
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
txtFilePath.Text = ""
If txtFilePath = "" Then cmdCompact.Enabled = False
End Sub
Private Sub txtFilePath_Change()
If txtFilePath = "" Then
cmdCompact.Enabled = False
Else
cmdCompact.Enabled = True
End If
End Sub
Private Sub txtFilePath_LostFocus()
If txtFilePath = "" Then
cmdCompact.Enabled = False
Else
cmdCompact.Enabled = True
End If
End Sub
|
|