การกำหนด Path ของไฟล์ฐานข้อมูลด้วย INI (Initialized File) โดยที่ไม่ต้องเรียกใช้งาน API

Option Explicit

Private Sub cmdOpenDB_Click()
'On Error Resume Next
On Error GoTo ErrHandler
Dim oMdbFile As String
    ' เปิดไฟล์ฐานข้อมูล
    oMdbFile = Trim(txtSelectMDB.Text)
    dlgOpenDB.FileName = ""
    dlgOpenDB.CancelError = True ' ไม่สนใจ Error ที่เกิดขึ้น
    dlgOpenDB.InitDir = App.Path    ' เลือกตำแหน่งปัจจุบันของ Project
    dlgOpenDB.DialogTitle = "เลือกตำแหน่งไฟล์ Microsoft Access" ' ตั้งค่า Title ของ Dialog
    dlgOpenDB.Filter = "Microsoft Access (*.mdb) | *.mdb" ' แสดงผลเฉพาะไฟล์ MDB
    dlgOpenDB.ShowOpen
    dlgOpenDB.DefaultExt = "*.mdb" ' ตั้งค่า MS Access (MDB) เป็นค่าเริ่มต้น
    
    oMdbFile = dlgOpenDB.FileName
    If oMdbFile = "" Then Exit Sub
    txtSelectMDB.Text = oMdbFile

ExitProc:
    Exit Sub

ErrHandler:
    ' หากไม่เท่ากับ 32755 ... คือหมายเลข Error 32755 นี้ คือ การกดปุ่ม Cancel น่ะครับ
    ' พูดง่ายๆ ผมไม่สนใจการเกิด Error นี้น่ะครับ ... แต่ Error อื่นๆ จะคอยดักไว้อีกที
    If Err.Number <> 32755 Then
        MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
        ' Resume ExitProc
    End If
    ' ================================================================
    ' แต่อันที่จริงน่ะครับ ต้องพิจารณาการใช้งาน Resume ในแต่ละจุดที่เกิด Error เอาไว้ด้วยก็ดีครับ
    ' Resume ExitProc ... ไอ้นี่เด้งไปที่ Label : ExitProc เพื่อออกจากโปรแกรมย่อย
    ' Resume Next ... ไอ้นี่เด้งไปทำงานต่อจากจุดที่เกิด Error เลย ... ย้ำครับว่าต่อจากจุดที่เกิด Error
    ' การใช้ Label, Resume ร่วมกับ Exit Sub ในการดักจับ Trap Error มีความจำเป็นอย่างมากใน VB6
    ' ================================================================
End Sub

Private Sub cmdSave_Click()
    
    ' แม้ว่ามันไม่ใช่งานซ้ำซ้อนก็ตามที ... ก็ควรพยายามหัดเขียนให้เป็นส่วนของโปรแกรมย่อยไว้ด้วยก็ดีครับ
    ' จะได้คุ้นเคยเอาไว้ก่อนที่จะย้ายไป VB.NET
    ' ตรวจสอบค่าใน TextBox ต้องไม่เป็นค่าว่าง ... และทำการบันทึกข้อมูลลงใน Initial File (Employee.INI)
    If Trim$(txtSelectMDB.Text) <> "" Or Len(Trim$(txtSelectMDB.Text)) > 0 Then Call WriteINI
    
    MsgBox "ตำแหน่งไฟล์ข้อมูล:" & vbCrLf & txtSelectMDB.Text, vbOKOnly + vbInformation, "รายงานสถานะ"
    'Unload Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    ' จะใช้ส่วนนี้ได้ต้องตั้งค่าคุณสมบัติ (Properties) ของ Form
    ' KeyPreview = True ... ก่อนน่ะครับ
    Select Case KeyCode
        Case vbKeyF1: MsgBox "No help now."
        Case vbKeyF8: cmdSave_Click
        Case vbKeyEscape: Unload Me
    End Select
End Sub

Private Sub Form_Load()
    txtSelectMDB.Text = ""

    ' เรียกไปยังฟังค์ชั่นการอ่านค่าเริ่มต้น ... Initialize (ReadINI)
    txtSelectMDB.Text = ReadINI
    
    lblDescription.Caption = "การกำหนดตำแหน่งที่เก็บของไฟล์ฐานข้อมูลสำหรับโปรแกรมนี้ " & _
                        "มีจุดประสงค์เพื่อให้ระบบสามารถใช้งานได้ในแบบหลายผู้ใช้งาน (Multiuser) หรือ " & _
                        "สามารถมองเห็นข้อมูลข้ามเครื่องกันได้ในระบบเครือข่าย (Local Area Network) เดียวกัน."
End Sub


Employee.ini

' ส่วนที่ต้องนำมาใช้งาน ... และต้องนำไปใช้งาน
Function ReadINI() As String ' Return ค่า String กลับ
    ' หาก Return ค่ากลับมาจาก ReadIniValue เป็นค่าว่าง ... ก็ให้ใส่ Path ปัจจุบัน และ ชื่อไฟล์ MS Access เข้ามาเลย
    ' ส่วนแรก คือ INI Path เช่น C:\ProjectVB\Employee\Employee.ini ... หรือ Value ให้กับ Key
    ' ส่วนที่ 2 คือ Section ในที่นี้ใช้ Default
    ' และส่วนสุดท้าย คือ Key ในที่นี้ คือ DataBaseFile
    If ReadIniValue(App.Path & "\Employee.ini", "Default", "DataBaseFile") = "" Then
        WriteIniValue App.Path & "\Employee.ini", "Default", "DataBaseFile", App.Path & "\Employee.mdb"
    Else
        ReadINI = ReadIniValue(App.Path & "\Employee.ini", "Default", "DataBaseFile")
    End If
End Function

' ส่วนนี้ผมทำเป็นโปรแกรมย่อย (Sub Program) ... เพราะมันไม่มีการ Return ค่ากลับ
' จะต่างจาก ReadINI ที่จะต้องมีการ Return ค่ากลับ
Sub WriteINI()
    ' บันทึกค่าจาก TextBox เข้าสู่ไฟล์ INI ... เพื่อกำหนด Path ให้กับไฟล์ฐานข้อมูล
    WriteIniValue App.Path & "\Employee.ini", "Default", "DataBaseFile", txtSelectMDB.Text
End Sub

Option Explicit

Global ConnDB As New ADODB.Connection
' =============================================================
' หมายเหตุ: ... พี่น้องครับ พยายามลดตัวแปรในการเชื่อมต่อตารางข้อมูลไว้บ้างก็ดีน่ะครับ
' ไม่ใช่เล่นแบบประกาศตัวแปร Object RecordSet เอาหมดกันแทบทุกๆตาราง ... เฮ้อ ...
' ตั้งแต่ผมเขียนโปรแกรมด้วย VB6 มา ผมใช้ตัวแปร RecordSet ไม่เกิน 3 ตัวสักครั้งเลย
' Global RS As New ADODB.Recordset   ' เราให้เป็นตัวหลัก
' Global DS As New ADODB.Recordset   ' กำหนดให้เป็นตัวรอง
' Global Statement As String
' Global SQLStmt As String
' =============================================================

' ส่วนแก้ไขจากของเดิมๆ ... ที่ผมเคยให้โค้ดไปตั้งแต่ปีมะโว้แล้ว
Public Sub OpenDataBase()
On Error GoTo Err_Handler
Dim DB_File As String

    ' อ่านตำแหน่งของไฟล์ฐานข้อมูลเข้ามาก่อนด้วย ReadIniValue
    DB_File = ReadIniValue(App.Path & "\Employee.ini", "Default", "DataBaseFile")
    
    ' หากไม่พบข้อมูลที่กำหนดไว้ ให้สร้าง Section, Key และ Value ขึ้นมาใหม่ด้วย WriteIniValue เมื่อ
    ' Section = [Default] ... ใส่เครื่องหมาย Bracket [ ... ] เอาไว้ด้วย
    ' Key = DatabaseFile
    ' Value = ตำแหน่งไฟล์ MS Access
    If DB_File = "" Then
        WriteIniValue App.Path & "\Employee.ini", "Default", "DataBaseFile", App.Path & "\Employee.mdb"
        ' ส่งค่าให้กับตัวแปร DB_File
        DB_File = ReadIniValue(App.Path & "\Employee.ini", "Default", "DataBaseFile")
    End If
    ' เปิดการเชื่อมต่อฐานข้อมูล
    Set ConnDB = New ADODB.Connection
    ConnDB.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & DB_File & ";" & _
        "Persist Security Info=False;"
    ConnDB.Open

ExitProc:
    Exit Sub
    
Err_Handler:

Error ในกรณีที่หาไฟล์ไม่เจอ ... และยังมีโอกาสเกิด Error กับระบบไฟล์ได้อีกเพียบ
ลองดัก หรือ Trap Error พื้นๆ ที่อาจจะเกิดขึ้น เอาเองด้วยน่ะครับ
    ' หาไฟล์ไม่เจอ ...
    If Err.Number = -2147467259 Then
        MsgBox "Open Database Error : " & Err.Number & vbCrLf & _
                        "ไม่พบไฟล์ข้อมูล : " & Mid$(Err.Description, 21, Len(Err.Description)) & vbCrLf & _
                        "กรุณานำไฟล์ข้อมูลไปเก็บไว้ในตำแหน่งที่คุณระบุด้วย.", vbCritical + vbOKOnly, "รายงานสถานะ"
        'Resume ExitProc
        End
    Else
        MsgBox "Open Database Error : " & vbCrLf & Err.Number & " " & Err.Description
        Resume ExitProc
    End If
End Sub