แจกฟรี Source Code VB6+Access โปรแกรมระบบฐานข้อมูลครุภัณฑ์ ภาคเขียนโปรแกรม

' ส่วนของการนำข้อมูลมาแสดงผล
Sub RecordToScreen()
Set RS = New Recordset
    ' นำข้อมูลจากตารางมาแสดงผล
    ' ไม่ต้องมาขยันนั่งพิมพ์เองหรอกครับ 
    ' ไปใช้แบบสอบถาม (Query) ใน MS Access และทำการตัดเข้ามาเลย ...
    Statement = "SELECT tblAsset.AssetPK, tblAsset.AssetID, tblAsset.SerialNumber, " & _
                            " tblAsset.Class, tblAsset.Model, tblAsset.DateReceived, tblAsset.UnitPrice, " & _
                            " tblAsset.Reference, tblAsset.Memo, tblAsset.DateAdded, " & _
                            " tblAsset.DateModified, tblAssetName.AssetName, tblBrandName.BrandName, " & _
                            " tblGroup.GroupName, tblUnit.UnitName, tblSource.SourceName, " & _
                            " tblStatus.StatusName, tblLocation.LocationName " & _
                            " FROM (tblSource INNER JOIN ((tblGroup INNER JOIN " & _
                            " (tblBrandName INNER JOIN (tblAssetName INNER JOIN " & _
                            " (tblUnit INNER JOIN tblAsset ON tblUnit.UnitPK = tblAsset.UnitFK) ON " & _
                            " tblAssetName.AssetNamePK = " & _
                            " tblAsset.AssetNameFK) ON tblBrandName.BrandNamePK = " & _
                            " tblAsset.BrandNameFK) ON tblGroup.GroupNamePK = tblAsset.GroupNameFK) " & _
                            " INNER JOIN tblLocation ON tblAsset.LocationFK = tblLocation.LocationPK) " & _
                            " ON tblSource.SourcePK = tblAsset.SourceFK) INNER JOIN tblStatus ON " & _
                            " tblAsset.StatusFK = tblStatus.StatusPK " & _
                            " WHERE [tblAsset.AssetPK] = " & PK & _
                            " ORDER BY [tblAsset.AssetPK] "

        RS.Open Statement, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
        ' กำหนดการแสดงผลข้อมูลบนหน้าจอ
        txtAssetID.Text = "" & RS("AssetID")
        
        ' ต้องเก็บค่าเดิมของทะเบียนครุภัณฑ์ไว้ก่อน (อ่านรายละเอียดที่ cmdSave_Click)
        ' ใช้เทคนิคง่ายๆ หมูๆ ... เอาค่าใน Text ไปเก็บไว้ในหาง เอ้ย Tag
        ' พี่น้องคงจะได้รู้ประโยชน์ของการใช้งาน Tag แหละคราวนี้ ... ความลับที่ซุกซ่อนใน VB มาแสนนาน
        ' มันมีคุณสมบัติประจำตัว Tag เอาไว้ทำอะไร ... 55555+ ... จุ๊กกรู๊
        txtAssetID.Tag = txtAssetID.Text
        
        ' การโหลดค่าจากตารางย่อย (tblBrandName) เข้าสู่ ComboBox
        ' พิจารณาการเชื่อมโยงตารางยี่ห้อ (tblBrandName)
        ' ไปโปรแกรมย่อยในการโหลดรายการต่างๆของตารางย่อย (Detail) เข้าสู่ ComboBox ค่าที่ส่งไปมี
        ' ชื่อ ComboBox, ชื่อตาราง, ชื่อ Field ที่เป็น Primary Key, ชื่อฟิลด์ที่เป็นรายการ
        Call LoadComboBox( _
                cmbBrandName, _
                "tblBrandName", _
                "BrandNamePK", _
                "BrandName" _
                )
            
        ' เอาค่าที่อยู่ในตารางข้อมูล เทียบค่าให้ตรงกันในรายการ (List) ของ ComboBox
        cmbBrandName.Text = RS("BrandName")
        ' ===========================================================================
        
        ' ส่วนอื่นๆ ให้ไปดูที่โค้ดโปรแกรมได้เลย
        ' .........................
        ' .........................
End Sub

' Load รายการเข้าสู่ ComboBox ค่าที่ต้องส่งมา 4 ชุด คือ
' ชื่อ ComboBox, ชื่อตาราง, ชื่อฟิลด์ Primary Key และ ชื่อฟิลด์รายการ
Sub LoadComboBox( _
    cmb As ComboBox, _
    tblName As String, _
    FieldPK As String, _
    FieldName As String _
    )
    
    Set DS = New ADODB.Recordset
    SQLStmt = "SELECT * FROM " & tblName & " ORDER BY " & FieldName
    Set DS = ConnDB.Execute(SQLStmt, , adCmdText)
    
    cmb.Clear

    Do Until DS.EOF
        cmb.AddItem "" & DS(FieldName)
        DS.MoveNext
    Loop
    DS.Close:    Set DS = Nothing
End Sub

' จะอยู่ในเหตุการณ์ของการกดแป้นคีย์บอร์ด
Private Sub cmbBrandName_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        SendKeys "{TAB}"
    Else
        ' ไปโปรแกรมย่อยในการค้นหาคำใน ComboBox โดยส่งค่าไป 2 ตัว
        ' ชื่อของ ComboBox และ KeyAscii ที่กดลงไป
        Call SearchComboBox(cmbBrandName, KeyAscii)
        
        ' จำกัดความยาวของการพิมพ์คำใน ComboBox
        Call MaxComboBox(cmbBrandName, 80, KeyAscii)
    End If
End Sub

' =========================================================
' โปรแกรมย่อยในการค้นหาคำในรายการของ ComboBox
Private Sub SearchComboBox(cmb As ComboBox, KeyAscii As Integer)
' =========================================================
Dim strKey As String, iRet As Long, LenKey As Long
    cmb.SelText = ""
    strKey = cmb.Text & Chr$(KeyAscii)
    iRet = SendMessage(cmb.hWnd, CB_FINDSTRING, -1, ByVal strKey)
    If iRet <> CB_ERR Then
        LenKey = Len(strKey)
        cmb.Text = cmb.List(iRet)
        cmb.ListIndex = iRet
        KeyAscii = 0
        cmb.SelStart = LenKey
        cmb.SelLength = Len(cmb.Text) - LenKey
    End If

End Sub
' =========================================================

' =========================================================
' ฟังค์ชั่นที่ช่วยจำกัดความยาวข้อมูลสำหรับ ComboBox
Private Sub MaxComboBox(cmb As ComboBox, MaxChar As Integer, KeyAscii As Integer)
' =========================================================
     If Len(cmb.Text) >= MaxChar Then ' ถ้าหากมีความยาวมากกว่า หรือ เท่ากับที่ได้ตั้งไว้
         If KeyAscii <> vbKeyBack Then ' เป็นการกดคีย์ Back Space หรือไม่
              KeyAscii = 0 ' ไม่ใช่ให้ถือว่าไม่ได้กดคีย์ใดๆเลย
         End If
    End If
End Sub
' =========================================================

Private Sub cmdSave_Click()
    ' ค่า AssetID หรือ ทะเบียนครุภัณฑ์ จำเป็นต้องป้อนเข้ามา
    If Trim(txtAssetID.Text) = "" Or Len(Trim(txtAssetID.Text)) = 0 Then
        MsgBox "กรุณาป้อนทะเบียนครุภัณฑ์ให้เรียบร้อยก่อนด้วย.", vbOKOnly + vbExclamation, "รายงานสถานะ"
        txtAssetID.SetFocus
        Exit Sub
    End If
    '
' ตรวจสอบการซ้ำกันของรหัสทะเบียนครุภัณฑ์
' =================================================================
' มันมีโอกาสเป็นได้ 2 กรณี คือ
' เพิ่มข้อมูลใหม่ - ทำให้ txtAssetID.Text จะไม่ตรงกันกับ txtAssetID.Tag (ค่านี้จะต้องว่าง)
' แก้ไขข้อมูล - มีโอกาสได้ 2 ทาง คือ
'      1. ไม่มีการแก้ไขค่าใน txtAssetdID.Text จะทำให้ txtAssetID.Text = txtAssetID.Tag
'           ดังนั้นไม่ต้องไปเสียเวลาทำการเปรียบเทียบค่าเดิมในฐานข้อมูล
'      2. มีการแก้ไขค่าใน txtAssetID.Text ดังนั้น txtAssetID.Text <> txtAssetID.Tag ทำให้
'          ต้องนำค่าไปตรวจสอบว่ามีค่า txtAssetID.Text (ที่เปลี่ยนไป) ไปซ้ำกับค่าเดิมในฐานข้อมูลหรือไม่
' เขียน VB มานับ 10 ปี ... เทคนิคง่ายๆนี้ ผมก็ยังใช้งานได้ไม่เปลี่ยนแปลงทั้ง VB6 หรือ VB.Net
' =================================================================
If txtAssetID.Text <> txtAssetID.Tag Then
    If CheckNewCode > 0 Then
        MsgBox "มีทะเบียนครุภัณฑ์: " & Trim(txtAssetID.Text) & " เรียบร้อยแล้ว กรุณาแก้ไขใหม่ด้วย.", _
                            vbOKOnly + vbExclamation, "รายงานสถานะ"
        txtAssetID.SetFocus
        Exit Sub
    End If
End If
' ================================
' ไปบันทึกข้อมูลได้เลย
Call SaveData
' ================================
End Sub

' =================================================================
' ฟังค์ชั่นตรวจสอบการซ้ำกันของทะเบียนครุภัณฑ์ (หรืออื่นๆ) กรณีข้อมูลเป็น Text
' จากนั้นส่งค่ากลับ หากเป็น 0 แสดงว่าไปไม่เกิดการซ้ำกันของข้อมูล
' ค่าส่งกลับมากกว่า 0 ... เกิดการซ้ำกัน จะต้องบังคับไม่สามารถเพิ่ม หรือ แก้ไขข้อมูลได้
' =================================================================
Function CheckNewCode() As Long
    Set DS = New Recordset
    SQLStmt = "SELECT * FROM tblAsset  WHERE [AssetID] = " & "'" & Trim(txtAssetID.Text) & "'" & _
                            " ORDER BY [AssetPK] "
    
    ' หากไม่ระบุเป็น adUseClient จะใช้ค่าเดิมที่ตั้งต้น (Default) เป็นแบบ adUseServer
    ' การใช้แบบ adUseClient เพื่อต้องการให้ใช้เมธอดของการนับ Record ได้ นั่นคือ
    ' DS.RecordCount
    DS.CursorLocation = adUseClient
    DS.Open SQLStmt, ConnDB, adOpenForwardOnly,adLockReadOnly, adCmdText
    CheckNewCode = DS.RecordCount
    DS.Close:    Set DS = Nothing
End Function

' =================================================================
' โปรแกรมย่อยในการบันทึกข้อมูล ไม่ว่าจะเป็นการเพิ่ม หรือ การแก้ไขข้อมูล
' =================================================================
Private Sub SaveData()
Set RS = New Recordset
    ' มันเป็นเทคนิคของการลดจำนวนโค้ดลง ผมใช้มานับ 10 ปีแล้ว ... ไม่เปลี่ยน
    ' กรณีเป็นการเพิ่มข้อมูลใหม่
    If NewData  Then
        ' ค้นหาค่า PK ก่อน
        Call SetupNewData
        '
        Statement = "SELECT * FROM tblAsset ORDER BY AssetPK"
        RS.Open Statement, ConnDB, adOpenKeyset, adLockOptimistic, adCmdText
        ' ผมมันติด AddNew มาตั้งแต่ใช้ DAO แล้วครับ ... ส่วนนี้คือการใช้ INSERT น่ะครับ
        RS.AddNew
        RS("AssetPK") = PK
        RS("DateAdded") = FormatDateTime(Now(), vbShortDate)
        RS("DateModified") = FormatDateTime(Now, vbShortDate)
    '========== แก้ไขข้อมูล ============
    Else
        '
        Statement = "SELECT * FROM tblAsset WHERE AssetPK = " & PK
        RS.Open Statement, ConnDB, adOpenKeyset, adLockOptimistic, adCmdText
    End If
    ' กรณีของ Text เพื่อป้องกันค่าว่าง ให้ใส่เครื่องหมาย Double Quote ไว้ด้านหน้าของ TextBox เสมอ
    RS("AssetID") = "" & Trim(txtAssetID.Text)
    RS("SerialNumber") = "" & Trim(txtSerialNumber.Text)
    RS("Model") = "" & Trim(txtModel.Text)
    RS("Class") = "" & Trim(txtClass.Text)
    '
    ' ตรวจสอบค่าใน ComboBox
    ' ยี่ห้อ - BrandName
    ' ชื่อครุภัณฑ์ โดยการส่งค่าไปตรวจสอบหาค่า Primary Key ของตารางย่อย (Detail) ค่าที่ส่งไป มี
    ' ชื่อ ComboBox, ชื่อตาราง, Field ที่เป็น PK, Field ที่เป็นรายการ (ค่าที่ต้องทดสอบหา Primary Key)
    ' ค่าที่ส่งกลับมาจะเป็น Primary Key ของแต่ละตารางย่อยนั่นเอง
    ' และ Primary Key ตัวนี้ก็คือ Foreign Key ในตารางหลัก (tblAsset)
    ' อย่างที่ได้บอกไปตอนออกแบบข้อมูล เราจะเก็บค่า Foreign Key (BrandNameKF) นี้ลงในตารางหลักเท่านั้น
    RS("BrandNameFK") = VerifyComboBox( _
                                                        cmbBrandName, _
                                                        "tblBrandName", _
                                                        "BrandNamePK", _
                                                        "BrandName" _
                                                        )
    ' กรณีของ ComboBox ตัวอื่นๆก็เช่นเดียวกัน ดูได้จากโค้ดโปรแกรมจริงๆ
    ' ........................
    ' ........................
    RS.Update
    RS.Close: Set RS = Nothing
    '
    NewData = False
    ' ส่งค่าไปบอกฟอร์มหลักให้ Refresh
    FormUpdate = True
    MsgBox "บันทึกข้อมูลเรียบร้อย", vbOKOnly + vbInformation, "รายงานสถานะ"
    Unload Me
    
End Sub

' ===================== สร้าง Record ใหม่ ==========================
' ต้องคำนวณหาค่า Primary Key ให้เรียบร้อยก่อน
Sub SetupNewData()
' ==========================================================
Dim Rec As Long
Set DS = New Recordset
    ' นำข้อมูลจากตารางมาคำนวณหาค่า Primary Key สูงสุด
    SQLStmt = "SELECT Max(tblAsset.AssetPK) As MaxPK FROM tblAsset "
    ' กรณีการอ่านข้อมูลต้องใช้ adOpenForwardOnly คู่กับ adLockReadOnly เสมอ เพื่อการอ่านข้อมูลได้เร็วกว่า
    DS.Open SQLStmt, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
    ' ตัวแปร PK เป็นตัวแปรแบบ Public มองเห็นได้ทั่วทั้งฟอร์มนี้
    PK = DS("MaxPK") + 1
    DS.Close: Set DS = Nothing
End Sub

' ==========================================================
' ฟังค์ชั่นที่ใช้ในการตรวจสอบค่าที่อยู่ใน ComboBox เพื่อค้นหาค่า Primary Key ในตารางย่อย
' หากหาข้อมูลไม่พบ ก็สามารถบันทึกค่าที่คีย์เข้าไปใหม่ได้เลย โดยไม่จำเป็นต้องออกไปเพิ่มข้อมูลใหม่แต่อย่างใด
' ==========================================================
Function VerifyComboBox( _
    cmb As ComboBox, _
    tblName As String, _
    FieldPK As String, _
    FieldName As String _
    ) As Integer

Dim CountRec As Integer    ' ไว้นับจำนวนของตารางย่อย
    ' ตรวจสอบว่ามีการป้อนข้อมูลหรือไม่ หากไม่มีให้กำหนดค่า Default เป็น 0
    ' จากนั้น Return ค่ากลับ และออกจากฟังค์ชั่นไปเลยครับพี่น้อง ... เพื่อเป็นการไม่เสียเวลา
    If cmb.Text = "" Or Len(cmb.Text) = 0 Or cmb.Text = "-" Then
        VerifyComboBox = 0
        Exit Function
    End If
    
    Set DS = New Recordset
    SQLStmt = "SELECT * FROM " & tblName & " WHERE [" & FieldName & "] = " _
                        & "'" & Trim(cmb.Text) & "'" & _
                        " ORDER BY " & FieldPK
    ' ======================================================================
    ' หลายคนมักทำผิด และมองข้ามมันไป สำหรับการเขียน SQL Statement
    ' SQL Statement ... การค้นหาค่าโดยการเปรียบเทียบกับข้อมูลชนิดข้อความ Text หรือ String
    ' SELECT * FROM ... WHERE [ฟิลด์แบบข้อความ] = '1020' ... (อ่านว่า หนึ่ง ศูนย์ สอง ศูนย์)
    ' เวลาเขียน Statement จะต้องเขียนค่าที่นำมาเปรียบเทียบให้อยู่ภายใต้เครื่องหมาย Single Quote (') เช่น
    ' "SELECT * FROM ... WHERE [AssetID] = " & "'" & txtAssetID.Text & "'" ... จดจำรูปแบบนี้ให้ดี
    ' ส่วนกรณีของตัวเลขไม่ต้องมีเครื่องหมาย Single Quote เช่น
    ' SELECT * FROM ... WHERE AssetPK = 1020 (อ่านว่า หนึ่งพันยี่สิบ) เช่น
    ' "SELECT * FROM ... WHERE [AssetPK] = " & txtAssetPK.Text
    ' ======================================================================
    
    DS.CursorLocation = adUseClient
    DS.Open SQLStmt, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
    CountRec = DS.RecordCount
    
    ' แสดงว่าไม่มีในรายการ ดังนั้นเราต้องเพิ่มรายการเข้าไปใหม่ในตารางย่อย
    If CountRec <= 0 Then
        Set DS = New Recordset
        SQLStmt = "SELECT Max(" & tblName & "." & FieldPK & ") As MaxPK " & " FROM " & tblName
        DS.CursorLocation = adUseClient
        DS.Open SQLStmt, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
        ' เพิ่มค่า Primary Key ของตารางย่อย (Detail) ขึ้นอีก 1
        CountRec = DS("MaxPK") + 1
        
        ' การที่ผมไม่สั่งปิดตารางข้อมูล DS.Close ก็เพราะคำสั่ง Set DS = New Recordset
        ' มันจะตัดการชื่อมต่อเดิมออกไปในทันทีได้เลยครับ ... ไม่ต้องห่วง
        Set DS = New Recordset
        SQLStmt = "SELECT * FROM " & tblName & " ORDER BY " & FieldPK
        ' การบันทึกข้อมูล จะใช้ adOpenKeyset คู่กับ adLockOptimistic เสมอครับ
        DS.Open SQLStmt, ConnDB, adOpenKeyset, adLockOptimistic, adCmdText
        ' ผมมันติด AddNew มาตั้งแต่ใช้ DAO แล้วครับ ... ส่วนนี้คือการใช้ INSERT น่ะครับ
        DS.AddNew
        DS(FieldPK) = CountRec
        DS(FieldName) = cmb.Text
        DS.Update
        ' ส่งค่า PK กลับไปเพื่อบันทึกข้อมูล
        VerifyComboBox = CountRec
        
    ' มีข้อมูลเดิมอยู่แล้ว
    Else
        ' ส่งค่า PK กลับไปเพื่อบันทึกข้อมูล
        VerifyComboBox = DS(FieldPK)
    End If
    DS.Close:    Set DS = Nothing
End Function

' เคลียร์ข้อมูลต่างๆใหม่
Sub SetupScreen()
    ' ============= เสริมเทคนิคการเคลียร์ค่าต่างๆของ Control ในฟอร์ม ==============
    Dim Ctl As Control
    ' สำหรับ Control ทุกๆตัวที่วางแปะลงบน Form
    For Each Ctl In Me
        ' ถ้า Control ตัวนั้นมันเป็น TextBox ก็ทำการใส่ค่าว่างให้มันซ่ะ
        If TypeOf Ctl Is TextBox Then Ctl.Text = ""
        ' ถ้า Control ตัวนั้นมันเป็น ComboBox ก็ทำการเคลียร์ค่าว่างให้มันซ่ะ
        If TypeOf Ctl Is ComboBox Then Ctl.Clear
    Next ' Control ตัวถัดไป
End Sub