frmhidefun.frm

通用书店管理系统

    N = 0
    
    Set dicU = CreateObject("Scripting.Dictionary")
    
    cN.BeginTrans
    
    Set st = New ADODB.Recordset
    SS = "select chrBookTypeNo,ChrBookType from BookType"
    st.Open SS, cN, adOpenStatic, adLockReadOnly
    Do While Not st.EOF
        strKey = Trim(st.Fields("ChrBookType"))
        If dicU.Exists(strKey) Then
            SS = "delete from BookType where chrBookTypeNo='" _
                & st.Fields("chrBookTypeNo") & "'"
            cN.Execute SS
            N = N + 1
        Else
            dicU.Add strKey, ""
        End If
        st.MoveNext
    Loop
    
    
    cN.CommitTrans
    
    Set st = Nothing
    Set dicU = Nothing
    MsgBox "结束。共有 " & N & " 个记录删除。"
    Exit Sub
Err:
    cN.RollbackTrans
    MsgBox Err.Description
    Exit Sub

End Sub

Private Sub Command6_Click()
'Dim st As ADODB.Recordset
Dim SS As String
    Dim intEff As Long
'    Set st = New ADODB.Recordset
'    SS = "select * from selltable_list"
'    st.Open SS, cN, adOpenStatic, adLockReadOnly
'    If Not st.EOF Then
'        If st.Fields("ChrBookNo") <> "a1" Or st.Fields("ChrBookNo") <> "a2" Or st.Fields("ChrBookNo") <> "a3" & _
'            st.Fields("ChrBookNo") <> "a5" Or st.Fields("ChrBookNo") <> "a6" Or st.Fields("ChrBookNo") <> "a7" Or st.Fields("ChrBookNo") <> "a8" & _
'            st.Fields("ChrBookNo") <> "a9" Or st.Fields("ChrBookNo") <> "a10" Or st.Fields("ChrBookNo") <> "a11" Then
'          SS = "updata selltable_List set ChrProduceType='图书'"
'        Else
'          SS = "updata selltable_List set ChrProduceType='文具/精品'"
'        End If
'    End If
  On Error GoTo Err
    cN.BeginTrans
    
    SS = "update selltable_list set chrproducetype=' '"
    cN.Execute SS
    SS = "update selltable_list,bookdata set selltable_list.chrproducetype=bookdata.chrproducetype Where selltable_list.chrbookno = bookdata.chrbookno And selltable_list.chrbookname = bookdata.chrbookname"
    cN.Execute SS, intEff
    
    cN.CommitTrans
    MsgBox "成功！共修改了" & intEff & "条记录。"
    Exit Sub
    
Err:
    cN.RollbackTrans
    MsgBox Err.Description
    Exit Sub

End Sub

Private Sub Command7_Click()
Dim i As Integer
  Dim decAgio As Double
  Dim sqlstring As String
  Dim strDate As String
  Dim strSellNo As String '销售单号
  Dim strRkDH As String '入库单号
  Dim rstmp As New ADODB.Recordset
  Dim rsNewTmp As New ADODB.Recordset
  Dim rs As ADODB.Recordset
    Dim rs1 As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
    Dim rs3 As ADODB.Recordset
  Dim rst As ADODB.Recordset
  
  On Error GoTo Err
        '入库实洋
'        sqlstring = "select * from bookstorage"
'        Set rs = New ADODB.Recordset
'        rs.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
        sqlstring = "select chrbookno,chrbookname,sum(数量*单价*折扣/100) as 实洋 from tmp_入库数据 group by chrbookno,chrbookname"
        Set rstmp = New ADODB.Recordset
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Do While Not rstmp.EOF
               sqlstring = "update bookstorage set DecZMY=" & rstmp.Fields("实洋") & " where chrBookNo='" & rstmp.Fields("chrbookno") & "' and chrbookname='" & rstmp.Fields("chrbookname") & "' "
                cN.Execute (sqlstring)
                rstmp.MoveNext
        Loop
'
        sqlstring = "select chrbookno,chrbookname,sum(deczmy) as deczm from bookstorage group by chrbookno,chrbookname"
        Set rs1 = New ADODB.Recordset
        rs1.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
        sqlstring = "select chrbookno,chrbookname,sum(DecPrice*DecAgio*IntSSS) as SY from InstorageInformation_List group by chrbookno,chrbookname"
        Set rsNewTmp = New ADODB.Recordset
        rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Do While Not rsNewTmp.EOF
           sqlstring = "update bookstorage set DecZMY=" & IIf(IsNull(rs1.Fields("deczm")), "0", rs1.Fields("deczm")) + rsNewTmp.Fields("SY") & " where chrBookNo='" & rsNewTmp.Fields("chrbookno") & "' and chrbookname='" & rsNewTmp.Fields("chrbookname") & "'"
            cN.Execute (sqlstring)
            rsNewTmp.MoveNext
        Loop
     
        '出库实洋

        sqlstring = "select chrbookno,chrbookname,sum(DecSum) as DecSu from selltable_list group by chrbookno,chrbookname"
        Set rst = New ADODB.Recordset
        rst.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Do While Not rst.EOF
'           sqlstring = "update bookstorage set DecCKSY=" & IIf(IsEmpty(rs2.Fields("DecCKSY")), "0", rs2.Fields("DecCKSY")) - rst.Fields("DecSu") & "  where chrbookno='" & rst.Fields("chrbookno") & "'"
            sqlstring = "update bookstorage set DecCKSY=" & rst.Fields("DecSu") & " where chrBookNo='" & rst.Fields("chrBookNo") & "'and chrbookname='" & rst.Fields("chrbookname") & "' "
            cN.Execute (sqlstring)
            rst.MoveNext
        
        Loop
        
        sqlstring = "select chrbookno,chrbookname,sum(deccksy) as deccks from bookstorage group by chrbookno,chrbookname"
        Set rs2 = New ADODB.Recordset
        rs2.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
        
        sqlstring = "select chrbookno,chrbookname,sum(DecPrice*DecAgio*IntAmount) as DecS from OutstorageInformation_List group by chrbookno,chrbookname"
        Set rs3 = New ADODB.Recordset
        rs3.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Do While Not rs3.EOF
           sqlstring = "update bookstorage set DecCKSY=" & IIf(IsNull(rs2.Fields("deccks")), "0", rs2.Fields("deccks")) + rs3.Fields("DecS") & " where chrbookno='" & rs3.Fields("chrbookno") & "'and chrbookname='" & rs3.Fields("chrbookname") & "'"
        cN.Execute (sqlstring)
        rs3.MoveNext
        Loop
        
        MsgBox "入库数据导入成功!", vbInformation

Err:
'  cN.RollbackTrans
  MsgBox Err.Description, vbInformation
End Sub

Private Sub Command8_Click()
    Dim sqlstring As String
    Dim rs As New ADODB.Recordset
    Dim rstmp As New ADODB.Recordset
    Dim rsNewTmp As New ADODB.Recordset

    
    On Error GoTo Err
    
    sqlstring = "select chrbookno,chrbookname,sum(数量*单价*折扣/100)/sum(数量) as 平均单价 from tmp_入库数据 group by chrbookno,chrbookname"
    Set rstmp = New ADODB.Recordset
    rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
    Do While Not rstmp.EOF
        sqlstring = "update bookstorage set DecAPrice=" & rstmp.Fields("平均单价") & " where chrbookno='" & rstmp.Fields("chrbookno") & "' and chrbookname='" & rstmp.Fields("chrbookname") & "'"
    cN.Execute (sqlstring)
    rstmp.MoveNext
    Loop
    
    sqlstring = "select chrbookno,chrbookname,sum(IntAmount) as IntS, DecAPrice from bookstorage where IntAmount<>0 group by chrbookno,chrbookname,DecAPrice"
    Set rsNewTmp = New ADODB.Recordset
    rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
    
    
    sqlstring = "select chrbookno,chrbookname,sum(IntSSS) as IntSS,sum(DecPrice*DecAgio*IntSSS)/sum(IntSSS) as DecPrice1 from InstorageInformation_List where IntSSS <>0 group by chrbookno,chrbookname"
    Set rs = New ADODB.Recordset
    rs.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
    Do While Not rs.EOF
         sqlstring = "update bookstorage set DecAPrice=" & (rs.Fields("DecPrice1") * rs.Fields("IntSS") + rsNewTmp.Fields("DecAPrice") * rsNewTmp.Fields("IntS")) / (rs.Fields("IntSS") + rsNewTmp.Fields("IntS")) & " where chrbookno='" & rs.Fields("chrbookno") & "' and chrbookname='" & rs.Fields("chrbookname") & "'"
    cN.Execute sqlstring
    rs.MoveNext
    Loop
    
    MsgBox "平均单价数据导入成功!", vbInformation
    
Err:
 MsgBox Err.Description, vbInformation
End Sub

Private Sub Command9_Click()
Dim sqlstring As String

On Error GoTo Err
cN.BeginTrans

    sqlstring = "delete * from bookdata"
    cN.Execute sqlstring
    sqlstring = "delete * FROM BooksBorrow"
    cN.Execute sqlstring
    sqlstring = "delete * FROM BooksPriceDiscount"
    cN.Execute sqlstring
    sqlstring = "delete * from bookstorage"
    cN.Execute sqlstring
    sqlstring = "delete * from booksxujie"
    cN.Execute sqlstring
    sqlstring = "delete * from ClientData"
    cN.Execute sqlstring
    sqlstring = "delete * from HistoryStockQuery"
    cN.Execute sqlstring
    sqlstring = "delete * from InStorageInformation"
    cN.Execute sqlstring
    sqlstring = "delete * from InStorageInformation_List"
    cN.Execute sqlstring
    sqlstring = "delete * from KCXXSZ"
    cN.Execute sqlstring
    sqlstring = "delete * from MemberCard"
    cN.Execute sqlstring
    sqlstring = "delete * from MemberData"
    cN.Execute sqlstring
    sqlstring = "delete * from MonthlyPDInput"
    cN.Execute sqlstring
    sqlstring = "delete * from OutstorageInformation"
    cN.Execute sqlstring
    sqlstring = "delete * from OutstorageInformation_List"
    cN.Execute sqlstring
    sqlstring = "delete * from PDControl"
    cN.Execute sqlstring
    sqlstring = "delete * from PDResult"
    cN.Execute sqlstring
    sqlstring = "delete * from SellTable"
    cN.Execute sqlstring
    sqlstring = "delete * from SellTable_List"
    cN.Execute sqlstring
    sqlstring = "delete * from StorageFirstInput"
    cN.Execute sqlstring
    sqlstring = "delete * from StorageInput"
    cN.Execute sqlstring
    sqlstring = "delete * from TuiShuTable"
    cN.Execute sqlstring
    sqlstring = "delete * from TuiShuTable_List"
    cN.Execute sqlstring
    sqlstring = "delete * from tper_basEmployee where chrEmployeeId <> '001'"
    cN.Execute sqlstring
    sqlstring = "delete * from tau_userauth where chrusername<>'001'"
    cN.Execute sqlstring
    sqlstring = "delete * from tau_usergroup where chrusername<>'001' and chrusername<>'admin' and chrusername<>'root'"
    cN.Execute sqlstring
    sqlstring = "delete * from tau_users where chrworknum <> '001' and chrusername<>'admin' and chrusername<>'abc'"
    cN.Execute sqlstring
    sqlstring = "update tau_users set chrworknum='admin' where chrusername='admin'"
    cN.Execute sqlstring
    sqlstring = "delete * from Company where chrCompanyNo<>'01' and chrCompanyName<>'阳光书社'"
    cN.Execute sqlstring
    sqlstring = "update Company set chrCompanyName='南郑县教育书店' where chrCompanyNo='01'"
    cN.Execute sqlstring
    
    
cN.CommitTrans
    MsgBox "数据库清空已成功！", vbInformation
Exit Sub
Err:
    
    cN.RollbackTrans
    MsgBox Err.Description, vbInformation
End Sub