ҡդӶ ʵŧ 纺촨շ٨絴͵ ᷹ФѺ

͵Դҷҧ Inbox Ѻ

˹ѡ
-
VB 6/VB.Net
ASP/ASP.Net
Ѻ¤
¹ҹ Flash Movie
ռͺش  
 RSS Feeds
 ǹŴ RSS Reader ...   Download  RSS Reader

Forum - www.g2gnet.com
Webmaster - www.g2gnet.com
Visitors - Session views
 5 6 1 6 1 7 4

7 ѹҤ ..2549
129 Users On-Line.
Visitors - Page views
 8 9 7 3 9 1 7
1 Ҿѹ ..2551

Google   
g2gnet.com
Ҵѡ:  

ᨡ Source Code VB6+Access кҹŤѳ Ҥ¹

Category »  VB 6/VB.Net
: Webmaster 16/4/2552   : 12:20
(ҹ : 342684) 
ͧѺ ... ӾѧԴ ѡõҧѹѧ§ ѹͧաþ٨ ҧŷ͡Ẻҹ ѹդ١ͧ Өԧҧ ͹Ѻ ... ѹͧþ٨¡ŧͻԺѵҹ 觷Դ ѧ ö·ʹѧ "ͧԧ ͷ շش" ... ФѺ Ѻ¹дѺͧҾ͡ҡҡ ǹдѺҧͨͧ͡ ѹҡӺҡ еͼѲҡԹ ͧѺ ... ¹ ¹ ¹ͧ㨼ҹ ҧǼҹ () ͧõҧ դ֡͵ҹҹҧѹ Ѵਹ¡ ѹѺ Excel 红ҧѧдիСա ... 55555+ ...
ǹŴ
ǹŴ Source Code Ѻ MS Visual Basic 6.0 - Service Pack 6
 ǹŴ Visual Basic 6.0 SP5: Run-Time Redistribution Pack
 ǹŴ Microsoft Data Access Object (MDAC) Jet 4.0 Update
 ǹŴ Microsoft Visual Basic Service Pack 6

ᨡ Source Code VB6+Access кҹŤѳ Ҥҧ
  • ùӢŨҡҧԴʴ - RecordToScreen

    • ҷ繵˹ѧ Ҥѡ ѡѹ (ѡ蹡) ǹԸա红Ẻ Text ᷺ 㹡óẺ ŷʴ ComboBox ҡդҫӡѹ ҡ SELECT DISTINCTROW Ŵӹǹʴ ҡ鹡йӤҷ Text ŧҧѡ ... ͹ ҾѲ 繤ҹ ͧͧ Maintenance кҹ ѺاԷҾѹҧ˹ ... ѧ;ͧҹ ͧԨóҳ㹡õѴԹͧ͡СѹѺ Ẻ˹ѹջԷҾҡҡѹ
    鹡кǹ÷ӧҹ
    
    ' ǹͧùӢʴ
    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
    
       
  • äҢ ComboBox - SearchComboBox
  • èӡѴǢ ComboBox - MaxComboBox
    
    ' ˵ءóͧá鹤
    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 ' =========================================================
  • úѹ֡ ͡ 2 ѡɳ
    • ǹӤѭ Primary Key AssetID ͧ仫ӡѺͧ
    • Ӥѭͧ AssetID դҫӡѺͧ
    
    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  ==========================
    ' ͧӹdzҤ Primary Key º¡͹
    Sub SetupNewData()
    ' ==========================================================
    Dim Rec As Long
    Set DS = New Recordset
        ' ӢŨҡҧҤӹdzҤ 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
    
    Conclusion:
    Ҵѧ ͷзͧ·ҹǤԴ ͧš ʹ ѹҧùФѺ ˹ѡҧѹͧҧẺ 1 : 1 ŧ鴨ԧѹ¡ѹ (ҧҨк͡ѹҡ仫д«) ͺ˹ҼҵҧҹԧͧԡʴͧǷҧ ͹ѹеͧѡɳТͧѹẺ 1 : M ... Ҿ觷͡ѹ͹ФѺ ... ͧ

  • ͵ - g2gNet Dot Com
    Ţ¹ҳԪ硷͹ԡ 0407314800231
    CopyLeft © 2004 - 2099 g2gNet.Com All rights reserved.
    Email: [email protected] . 08-6862-6560