frmhidefun.frm

通用书店管理系统

VERSION 5.00
Begin VB.Form frmHideFun 
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5925
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   5925
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command10 
      Caption         =   "补充空平均单价数据"
      Height          =   375
      Left            =   60
      TabIndex        =   9
      Top             =   1680
      Width           =   3315
   End
   Begin VB.CommandButton Command9 
      Caption         =   "清空数据库"
      Height          =   375
      Left            =   3360
      TabIndex        =   8
      Top             =   1320
      Width           =   2535
   End
   Begin VB.CommandButton Command8 
      Caption         =   "平均单价数据导入"
      Height          =   375
      Left            =   60
      TabIndex        =   7
      Top             =   1320
      Width           =   3315
   End
   Begin VB.CommandButton Command7 
      Caption         =   "入库数据库导入"
      Height          =   435
      Left            =   3360
      TabIndex        =   6
      Top             =   900
      Width           =   2535
   End
   Begin VB.CommandButton Command6 
      Caption         =   "修改销售记录增加的字段（制品类型）"
      Height          =   435
      Left            =   60
      TabIndex        =   5
      Top             =   900
      Width           =   3315
   End
   Begin VB.CommandButton Command5 
      Caption         =   "图书类型重复记录处理"
      Height          =   495
      Left            =   3600
      TabIndex        =   4
      Top             =   420
      Width           =   2295
   End
   Begin VB.CommandButton Command4 
      Caption         =   "修改图书资料供应商使用代码(目前清空)"
      Height          =   495
      Left            =   60
      TabIndex        =   3
      Top             =   420
      Width           =   3555
   End
   Begin VB.CommandButton Command3 
      Caption         =   "出版社重复记录处理"
      Height          =   435
      Left            =   60
      TabIndex        =   2
      Top             =   0
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "修改图书资料出版社使用代码"
      Height          =   435
      Left            =   3240
      TabIndex        =   1
      Top             =   0
      Width           =   2655
   End
   Begin VB.CommandButton Command1 
      Caption         =   "自动增加出版社"
      Height          =   435
      Left            =   1860
      TabIndex        =   0
      Top             =   0
      Width           =   1395
   End
End
Attribute VB_Name = "frmHideFun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
    ' 隐藏功能 根据图书资料更新出版社代码表，同时修改图书资料中的出版社（名称-》代号）
  

        Dim st As ADODB.Recordset
        Dim SS As String
        Dim intB As Integer
        
        On Error GoTo Err
        
        cN.BeginTrans
        
        intB = 300
        
        Set st = New ADODB.Recordset
        SS = "select distinct Chrbookconcern from (SELECT chrbookno, chrbookname, Chrbookconcern, chrCompanyNo, ChrCompanyName" _
            & " FROM bookdata left JOIN PublishingCompanyData ON bookdata.Chrbookconcern=PublishingCompanyData.ChrCompanyName" _
            & " where trim(Chrbookconcern)<>'' and ChrCompanyName is NULL)"
        st.Open SS, cN, adOpenStatic, adLockReadOnly
        Do While Not st.EOF
            If DBLen(Trim(st.Fields(0))) <> Len(Trim(st.Fields(0))) Then ' 是中文名称
                SS = "insert into PublishingCompanyData (chrCompanyNo,ChrCompanyName,ChrBenelux) values ( " _
                    & "'" & intB & "'," & "'" & st.Fields(0) & "','" & st.Fields(0) & "'" & ")"
                cN.Execute SS
                intB = intB + 1
            End If
            st.MoveNext
        Loop
        
        cN.CommitTrans
        Exit Sub


Err:
    cN.RollbackTrans
    MsgBox Err.Description
    Exit Sub

End Sub

Private Sub Command10_Click()
Dim sqlstring As String
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset

    sqlstring = "select ChrBookNo, ChrBookName,DecAPrice from bookstorage where DecAPrice=0"
    Set rs1 = New ADODB.Recordset
    rs1.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
    Do While Not rs1.EOF
        sqlstring = "SELECT ChrBookNo, ChrBookName, DecPrice FROM BookData where ChrBookNo='" & rs1.Fields("chrbookno") & "' and ChrBookName='" & rs1.Fields("chrbookname") & "'"
        Set rs2 = New ADODB.Recordset
        rs2.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
        sqlstring = "update bookstorage set DecAPrice='" & rs2.Fields("DecPrice") & "' where ChrBookNo='" & rs1.Fields("chrbookno") & "' and ChrBookName='" & rs1.Fields("chrbookname") & "'"
        cN.Execute (sqlstring)
        rs1.MoveNext
    Loop
    
    MsgBox "补充平均单价数据导入成功!", vbInformation
End Sub

Private Sub Command2_Click()
    ' 修改图书资料中的出版社（名称->代号）
 

        Dim st As ADODB.Recordset
        Dim SS As String
        Dim intB As Integer
        Dim N As Integer
        
        On Error GoTo Err
        
        N = 0
        
        cN.BeginTrans
        
        intB = 300
        
        Set st = New ADODB.Recordset
        SS = "SELECT chrbookno, chrbookname, Chrbookconcern, chrCompanyNo, ChrCompanyName" _
            & " FROM bookdata INNER JOIN PublishingCompanyData ON bookdata.Chrbookconcern=PublishingCompanyData.ChrCompanyName"
        st.Open SS, cN, adOpenStatic, adLockReadOnly
        Do While Not st.EOF
            SS = "update bookdata set Chrbookconcern='" & st.Fields("chrCompanyNo") & "'" _
                & " where chrbookno='" & st.Fields("chrbookno") & "'" _
                & " and chrbookname='" & st.Fields("chrbookname") & "'"
            Debug.Print SS
            N = N + 1
            cN.Execute SS
            st.MoveNext
        Loop
        cN.CommitTrans
        MsgBox "结束。共有 " & N & " 个记录被修改。"
        Exit Sub


Err:
    cN.RollbackTrans
    MsgBox Err.Description
    Exit Sub

End Sub

Private Sub Command3_Click()
    Dim st As ADODB.Recordset
    Dim SS As String, strKey As String
    Dim dicU
    Dim N As Integer
    
    On Error GoTo Err
    
    N = 0
    
    Set dicU = CreateObject("Scripting.Dictionary")
    
    cN.BeginTrans
    
    Set st = New ADODB.Recordset
    SS = "select chrCompanyNo,ChrCompanyName from PublishingCompanyData"
    st.Open SS, cN, adOpenStatic, adLockReadOnly
    Do While Not st.EOF
        strKey = Trim(st.Fields("ChrCompanyName"))
        If dicU.Exists(strKey) Then
            SS = "delete from PublishingCompanyData where chrCompanyNo='" _
                & st.Fields("chrCompanyNo") & "'"
            cN.Execute SS
            N = N + 1
        Else
            dicU.Add strKey, ""
        End If
        st.MoveNext
    Loop
    
    'st.UpdateBatch adAffectAllChapters
    
    cN.CommitTrans
    
    Set st = Nothing
    Set dicU = Nothing
    MsgBox "结束。共有 " & N & " 个记录删除。"
    Exit Sub
Err:
    cN.RollbackTrans
    MsgBox Err.Description
    Exit Sub
End Sub

Private Sub Command4_Click()
    Dim SS As String
    
    cN.BeginTrans
    SS = "update bookdata set ChrGHS=''"
    cN.Execute SS
    cN.CommitTrans
    
End Sub

Private Sub Command5_Click()
    Dim st As ADODB.Recordset
    Dim SS As String, strKey As String
    Dim dicU
    Dim N As Integer
    
    On Error GoTo Err