เขียนโปรแกรมอย่างไรให้มี Error (การ Compact ไฟล์ Microsoft Access แบบมีรหัสผ่าน)

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