frminquireproduct.frm

VB礼品店销售管理系统 包括ACCESS数据库访问职工管理 账单管理

VERSION 5.00
Begin VB.Form frminquireProduct 
   Caption         =   "产品信息查询条件输入"
   ClientHeight    =   2505
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5280
   Icon            =   "frmInquireProduct.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2505
   ScaleWidth      =   5280
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOK 
      Caption         =   "确  定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1560
      TabIndex        =   0
      Top             =   1680
      Width           =   2175
   End
   Begin VB.ComboBox cmbProductID 
      Height          =   300
      Left            =   2160
      TabIndex        =   2
      Top             =   400
      Width           =   2175
   End
   Begin VB.ComboBox cmbProductName 
      Height          =   300
      Left            =   2160
      TabIndex        =   1
      Top             =   960
      Width           =   2175
   End
   Begin VB.Frame Frame1 
      Height          =   1575
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   5295
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "输入查询产品名称"
         Height          =   180
         Left            =   480
         TabIndex        =   5
         Top             =   1000
         Width           =   1440
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "输入查询产品编号"
         Height          =   180
         Left            =   480
         TabIndex        =   4
         Top             =   480
         Width           =   1440
      End
   End
   Begin VB.Frame Frame2 
      BorderStyle     =   0  'None
      Height          =   855
      Left            =   0
      TabIndex        =   6
      Top             =   1560
      Width           =   5295
   End
End
Attribute VB_Name = "frminquireProduct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdOK_Click()
On Error GoTo errhandle
    If Trim(cmbProductID.Text) = "" And Trim(cmbProductName) = "" Then
        MsgBox "请填写要查询的产品编号或产品名称！", 48, "信息提示"
        cmbProductID.SetFocus
        Exit Sub
    ElseIf Trim(cmbProductID.Text) <> "" And Trim(cmbProductName) = "" Then
        sqlstring = "select a.lsh,a.productid,a.productname,a.salesprice,a.shuliang," & _
                    " a.saledate,a.customerid,a.salespersonid,a.treesort,b.name," & _
                    " b.phone from tabsales a,customer b where a.customerid=b.id " & _
                    " and a.productid='" & Trim(cmbProductID) & "' order by a.saledate desc"
    ElseIf Trim(cmbProductID.Text) = "" And Trim(cmbProductName) <> "" Then
        sqlstring = "select a.lsh,a.productid,a.productname,a.salesprice,a.shuliang," & _
                    " a.saledate,a.customerid,a.salespersonid,a.treesort,b.name," & _
                    " b.phone from tabsales a,customer b where a.customerid=b.id " & _
                    " and a.productname='" & Trim(cmbProductName) & "' order by a.saledate desc"
    Else
        Dim rs As ADODB.Recordset
        sqlstring = "select * from product where productid='" & Trim(cmbProductID) & _
                    "' and productname='" & Trim(cmbProductName) & "'"
        dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
        Set rs = dbs.Execute(sqlstring)
        If rs.BOF Then
            rs.Close
            Set rs = Nothing
            dbs.Close
            MsgBox "产品编号与产品名称不匹配，请重新输入！", 48, "信息提示"
            cmbProductID.SetFocus
            Exit Sub
        Else
            sqlstring = "select a.lsh,a.productid,a.productname,a.salesprice,a.shuliang," & _
                        " a.saledate,a.customerid,a.salespersonid,a.treesort,b.name," & _
                        " b.phone from tabsales a,customer b where a.customerid=b.id " & _
                        " and a.productid='" & Trim(cmbProductID) & "' order by a.saledate desc"
            rs.Close
            Set rs = Nothing
            dbs.Close
        End If
    End If
    frmSaleproduct.Adodc1.CommandType = adCmdText
    frmSaleproduct.Adodc1.RecordSource = sqlstring
    frmSaleproduct.Adodc1.Refresh
    Call frmSaleproduct.cmdClear_Click
    Unload Me
    Exit Sub
errhandle:
    If Err.Number = 3705 Then
        dbs.Close
    End If
    MsgBox "有错误发生，错误编号为：" & Err.Number, 48, "信息提示"
End Sub

Private Sub Form_Load()
On Error GoTo errhandle
    Dim rs As ADODB.Recordset
    sqlstring = "select productid from product order by productId"
    dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";Persist Security Info=False"
    Set rs = dbs.Execute(sqlstring)
    rs.MoveFirst
    While Not rs.EOF
        cmbProductID.AddItem (rs.Fields("productid"))
        rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
    
    sqlstring = "select productname from product order by productid"
    Set rs = dbs.Execute(sqlstring)
    rs.MoveFirst
    While Not rs.EOF
        cmbProductName.AddItem (rs.Fields("productname"))
        rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
    dbs.Close
    Exit Sub
errhandle:
    If Err.Number = 3705 Then
        dbs.Close
    End If
    MsgBox "有错误发生，错误编号为：" & Err.Number, 48, "信息提示"
End Sub