clsbom.cls

这是一个利用VB编写的中小企业ERP。功能比较全

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsBOM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public ParentItem As String
Public CT As String
Public ChildItem As String
Public Qty As String
Public QT As String
Public Scrap As String
Public Offset As String
Public Remark As String

Public Sub Update(ByVal TempParentItem As String, ByVal TempChildItem As String)
    '连接数据库
    MyDB.openDB
    
    '设置Update语句
    SqlStmt = "Update Child Set ParentItem='" + Trim(ParentItem) _
               + "',CT='" + Trim(CT) _
               + "',ChildItem='" + Trim(ChildItem) _
               + "',Qty='" + Trim(Qty) _
               + "',QT='" + Trim(QT) _
               + "',Scrap='" + Trim(Scrap) _
               + "',Offset='" + Trim(Offset) _
               + "',Remark='" + Trim(Remark) _
               + "' where ParentItem='" + Trim(TempParentItem) + "' and ChildItem='" + Trim(TempChildItem) + "'"
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsChild As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsChild, True)
    
    '断开与数据库的连接
    MyDB.closeDB
    
End Sub


Public Sub DeleteP(ByVal TempParentItem As String)
    '连接数据库
    MyDB.openDB
    
    '设置DeleteP语句
    SqlStmt = "Delete FROM Parent WHERE ParentItem='" + Trim(TempParentItem) + "'"
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsParent As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsParent, True)
    
    '设置DeleteC语句
    SqlStmt = "Delete FROM Child WHERE ParentItem='" + Trim(TempParentItem) + "'"
    Isexe = MyDB.exeSql(SqlStmt, rsParent, True)
    
    '断开与数据库的连接
    MyDB.closeDB
End Sub


Public Sub DeleteC(ByVal TempParentItem As String, ByVal TempChildItem As String)
    '连接数据库
    MyDB.openDB
    
    '设置DeleteC语句
    SqlStmt = "Delete FROM Child WHERE ChildItem='" + Trim(TempChildItem) + "'And ParentItem='" + Trim(TempParentItem) + "'"
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsChild As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsChild, True)
    
    '断开与数据库的连接
    MyDB.closeDB
    
    
End Sub


Public Sub InsertC()
    
    '连接数据库
    MyDB.openDB
    
    '设置Insert语句
    SqlStmt = "INSERT INTO Child (ParentItem,CT,ChildItem,Qty,QT,Scrap,Offset,Remark) " _
               + " Values('" + Trim(ParentItem) + "','" + Trim(CT) _
               + "','" + Trim(ChildItem) + "','" + Trim(Qty) _
               + "','" + Trim(QT) + "','" + Trim(Scrap) + "','" + Trim(Offset) _
               + "','" + Trim(Remark) + "')"
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsChild As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsChild, True)
    
    '断开与数据库的连接
    MyDB.closeDB
    
End Sub


Public Function In_DBC(ByVal TempParentItem As String, ByVal TempChildItem As String) As Boolean
    
    '连接数据库
    MyDB.openDB
    
    '设置SQL语句
    SqlStmt = "SELECT  * FROM Child WHERE ParentItem='" + Trim(TempParentItem) + "' and ChildItem='" + Trim(TempChildItem) + "' "
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsChild As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsChild, False)
    
    '判断是否存在
    If rsChild.RecordCount <> 0 Then
        In_DBC = True
    Else
        In_DBC = False
    End If
    
    '断开与数据库的连接
    MyDB.closeDB
    
End Function


Public Sub Load_Parent()
    Dim i As Long
    Erase Arr_Item
    ReDim Arr_Item(0)
    
    '连接数据库
    MyDB.openDB
    
    '设置SQL语句
    SqlStmt = "SELECT Name FROM Item "
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsParent As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsParent, True)
    
    
    
    
    i = 0
    Do Until rsParent.EOF = True
        ReDim Preserve Arr_Item(i + 1)
        Arr_Item(i) = rsParent(0)
        i = i + 1
        rsParent.MoveNext
    Loop
    
    '断开与数据库的连接
    MyDB.closeDB
End Sub

Public Function In_DBP(ByVal TempParentItem As String) As Boolean
    
    '连接数据库
    MyDB.openDB
    
    '设置SQL语句
    SqlStmt = "SELECT  ParentItem FROM Parent WHERE ParentItem='" + Trim(TempParentItem) + "'"
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsParent As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsParent, False)
    
    '判断是否存在
    If rsParent.RecordCount <> 0 Then
        In_DBP = True
    Else
        In_DBP = False
    End If
    
    '断开与数据库的连接
    MyDB.closeDB
    
End Function


Public Sub InsertP()
    
    '连接数据库
    MyDB.openDB
    
    '设置Insert语句
    SqlStmt = "INSERT INTO Parent (ParentItem) Values('" + Trim(ParentItem) + "')"
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsParent As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsParent, True)
    
    '断开与数据库的连接
    MyDB.closeDB
    
End Sub


Public Sub Load_Parent_exist()
    Dim i As Long
    Erase Arr_Item
    ReDim Arr_Item(0)
    
    '连接数据库
    MyDB.openDB
    
    '设置SQL语句
    SqlStmt = "SELECT Name FROM Item,Parent where Item.Item=Parent.ParentItem  "
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsParent As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsParent, True)
    
    i = 0
    Do Until rsParent.EOF = True
        ReDim Preserve Arr_Item(i + 1)
        Arr_Item(i) = rsParent(0)
        i = i + 1
        rsParent.MoveNext
    Loop
    
    '断开与数据库的连接
    MyDB.closeDB
End Sub


Public Sub Load_Child(ByVal PItem As String)
    Dim i As Long
    Erase Arr_Item
    ReDim Arr_Item(0)
    
    '连接数据库
    MyDB.openDB
    
    '设置SQL语句
    SqlStmt = "SELECT Name FROM Item where Item<>'" + Trim(PItem) + " ' "
    
    '执行SQL语句
    Dim Isexe As Boolean
    Dim rsChild As ADODB.Recordset
    Isexe = MyDB.exeSql(SqlStmt, rsChild, True)
    
    i = 0
    Do Until rsChild.EOF = True
        ReDim Preserve Arr_Item(i + 1)
        Arr_Item(i) = rsChild(0)
        i = i + 1
        rsChild.MoveNext
    Loop
    
    '断开与数据库的连接
    MyDB.closeDB
End Sub