frmcheckgoods.frm

注释：用VB开发的进销存系统源码

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmCheckGoods 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据检查与维护"
   ClientHeight    =   5100
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6480
   Icon            =   "frmCheckGoods.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5100
   ScaleWidth      =   6480
   ShowInTaskbar   =   0   'False
   Begin ComctlLib.ProgressBar prg 
      Height          =   330
      Left            =   390
      TabIndex        =   4
      Top             =   3585
      Width           =   5565
      _ExtentX        =   9816
      _ExtentY        =   582
      _Version        =   327682
      Appearance      =   1
   End
   Begin VB.TextBox txtLog 
      Height          =   3090
      Left            =   405
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Top             =   180
      Width           =   5595
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   525
      Left            =   3720
      TabIndex        =   2
      Top             =   4380
      Width           =   1260
   End
   Begin VB.CommandButton Command2 
      Caption         =   "整理数据"
      Height          =   525
      Left            =   2370
      TabIndex        =   1
      ToolTipText     =   "整理数据是用最新的商品编码信息更新库存及进货等的商品记录！"
      Top             =   4380
      Width           =   1260
   End
   Begin VB.CommandButton Command1 
      Caption         =   "检查编码"
      Height          =   525
      Left            =   1035
      TabIndex        =   0
      ToolTipText     =   "检查编码是核对库存商品与现商品信息中存在差异的编码！"
      Top             =   4380
      Width           =   1260
   End
End
Attribute VB_Name = "frmCheckGoods"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private RsTemp As New ADODB.Recordset
Private R As New ADODB.Recordset

Private Sub Command1_Click()
    Dim sSQL
    On Error Resume Next
    txtLog.Text = "检查编码是核对库存商品与现商品信息中存在差异的编码！"
    txtLog.Text = txtLog.Text & vbCrLf & "配送中心库存："
    sSQL = "select 商品编码,品名,单位,颜色,尺寸,数量 from 配送中心库存"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    prg.Max = RsTemp.RecordCount
    prg.Value = 0
    Refresh

    While Not RsTemp.EOF
        sSQL = "select * from 商品信息 WHERE 商品编码='" & RsTemp("商品编码") & "' and 颜色='" & RsTemp("颜色") & "' and 尺寸='" & RsTemp("尺寸") & "'"
        Set R = Nothing
        R.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        If R.EOF Then
            txtLog.Text = txtLog.Text & vbCrLf & "未发现：商品编码:(" & RsTemp("商品编码") & ")颜色：(" & RsTemp("颜色") & ")尺寸:(" & RsTemp("尺寸") & ")"
        End If
        RsTemp.MoveNext
        prg.Value = prg.Value + 1
    Wend
    txtLog.Text = txtLog.Text & vbCrLf & "分店库存："
    sSQL = "select 商品编码,品名,单位,颜色,尺寸,数量 from 分店库存"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    prg.Max = RsTemp.RecordCount
    prg.Value = 0
    Refresh

    While Not RsTemp.EOF
        sSQL = "select * from 商品信息 WHERE 商品编码='" & RsTemp("商品编码") & "' and 颜色='" & RsTemp("颜色") & "' and 尺寸='" & RsTemp("尺寸") & "'"
        Set R = Nothing
        R.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        If R.EOF Then
            txtLog.Text = txtLog.Text & vbCrLf & "未发现：商品编码:(" & RsTemp("商品编码") & ")颜色：(" & RsTemp("颜色") & ")尺寸:(" & RsTemp("尺寸") & ")"
        End If
        RsTemp.MoveNext
        prg.Value = prg.Value + 1
    Wend
End Sub

Private Sub Command2_Click()
    Dim sSQL
    On Error Resume Next
    txtLog.Text = "整理数据是用最新的商品编码信息更新库存及进货等的商品记录！"
    txtLog.Text = txtLog.Text & vbCrLf & "正在清除配送中心库存数量为零的商品记录..."
    sSQL = "delete  from 配送中心库存 where 数量=0"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    
    txtLog.Text = txtLog.Text & vbCrLf & "正在清除分店库存数量为零的商品记录..."
    sSQL = "delete  from 分店库存 where 数量=0"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    
    txtLog.Text = txtLog.Text & vbCrLf & "正在更新商品信息..."
    
    sSQL = "select * from 商品主档"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    prg.Max = RsTemp.RecordCount
    prg.Value = 0
    Refresh
    While Not RsTemp.EOF
        sSQL = "update 分店库存 set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update 配送中心库存 set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update 售价调整单 set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update lsjhd set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update psd set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update lsxsd set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update lspdd set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update lsdbd set 品名='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update 商品信息 set 商品名称='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        sSQL = "update 分店销售信息 set 商品名称='" & RsTemp("品名") & "' where 商品编码='" & RsTemp("商品编码") & "'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        prg.Value = prg.Value + 1
        RsTemp.MoveNext
    Wend
    txtLog.Text = txtLog.Text & vbCrLf & "完成！"
End Sub

Private Sub Command3_Click()
    Unload Me
End Sub