clspurchase.cls

金算盘软件代码

           " AND ExpenseToPurchase.lngExpenseActivityDetailID = ItemActivityDetail_1.lngActivityDetailID " _
           & " AND ItemActivityDetail_1.lngActivityID=ItemActivity.lngActivityID " _
           & " AND (ItemActivityDetail.lngActivityDetailID)=" & lngActivityDetailID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        GoTo FFFF
    End If
    recTmp.MoveFirst
    Do While Not recTmp.EOF
        If recTmp!lngVoucherID > 0 Then
             cMsgBox "对应的费用单据已生成凭证，不能清除对照关系！"
             GoTo DeleteErr
        End If
'        If lngActivityTypeID = 5 Then
'            strSQL = "UPDATE ItemDaily1 SET ItemDaily1.dblEntrustExpense=ItemDaily1.dblEntrustExpense-" & recTmp(0) & _
'                " WHERE EXISTS (SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivityDetail " & _
'                " WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
'                " AND ItemActivityDetail.lngActivityDetailID=" & lngActivityDetailID & _
'                " AND ItemActivity.strDate=ItemDaily1.strDate " & _
'                " AND ItemActivity.lngCustomerID=ItemDaily1.lngCustomerID " & _
'                " AND ItemActivityDetail.lngItemID=ItemDaily1.lngItemID) "
'            If Not gclsBase.ExecSQL(strSQL) Then
'                GoTo DeleteErr
'            End If
'        End If
        strDetailID = strDetailID & recTmp(3) & ","
        strSQL = "UPDATE ItemActivityDetail SET dblExpenseAmount=dblExpenseAmount-" & recTmp(0) & " WHERE lngActivityDetailID=" & recTmp(4)
        gclsBase.BaseDB.Execute strSQL
'        recTmp.Edit
'            recTmp(1) = recTmp(1) - recTmp(0)
'        recTmp.Update
        recTmp.MoveNext
    Loop
FFFF:
'费用类商品
    strSQL = "SELECT ExpenseToPurchase.dblAmount, ItemActivityDetail_1.dblExpenseAmount, ItemActivityDetail_1.dblEntrustAmount, " _
           & " ItemActivityDetail.lngActivityDetailID,ItemActivityDetail_1.lngItemID,ItemActivityDetail_1.lngActivityDetailID  FROM ItemActivityDetail,ExpenseToPurchase,ItemActivityDetail ItemActivityDetail_1 " & _
           " WHERE ItemActivityDetail.lngActivityDetailID = ExpenseToPurchase.lngExpenseActivityDetailID " & _
           " AND ExpenseToPurchase.lngPurchaseActivityDetailID = ItemActivityDetail_1.lngActivityDetailID " _
           & " AND (ItemActivityDetail.lngActivityDetailID)=" & lngActivityDetailID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        GoTo DDDD
    End If
    recTmp.MoveFirst
    strItemIDList = "("
    Do While Not recTmp.EOF
        strDetailID = strDetailID & recTmp(3) & ","
        strItemIDList = strItemIDList & recTmp(4) & ","
        If lngActivityTypeID = 6 Then
'            strSql = "SELECT strDate,lngCustomerID,lngItemID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5)
'            Set recTmp3 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'            If Not (recTmp3.BOF And recTmp3.EOF) Then
'               strSql = "UPDATE ItemDaily1 SET dblEntrustExpense=dblEntrustExpense-" & recTmp(0) & " WHERE strDate='" & recTmp3!strDate & "' AND lngCustomerID=" & recTmp3!lngCustomerID & " AND lngItemID=" & recTmp3!lngItemID
'               gclsBase.BaseDB.Execute strSql
'            End If
'            recTmp3.Close
'            Set recTmp3 = Nothing

'            strSql = "SELECT strDate,lngItemID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5)
'            Set recTmp3 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'            If Not (recTmp3.BOF And recTmp3.EOF) Then
'               strSql = "UPDATE ItemDaily2 SET dblEntrustExpense=dblEntrustExpense-" & recTmp(0) & " WHERE strDate='" & recTmp3!strDate & "' AND lngItemID=" & recTmp3!lngItemID
'               If Not gclsBase.ExecSQL(strSql) Then
'                  recTmp3.Close
'                  Set recTmp3 = Nothing
'                  GoTo DeleteErr
'               End If
'            End If
'            recTmp3.Close
'            Set recTmp3 = Nothing
            strSQL = "UPDATE ItemDaily2 SET dblEntrustExpense= dblEntrustExpense-" & recTmp(0) & " WHERE EXISTS " & _
                " (SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
                " AND ItemActivity.strDate=ItemDaily2.strDate " & _
                " AND ItemActivityDetail.lngItemID=ItemDaily2.lngItemID " & _
                " AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5) & ")"
            If Not gclsBase.ExecSQL(strSQL) Then
                GoTo DeleteErr
            End If
            strSQL = "UPDATE PositionDaily SET dblEntrustExpense= dblEntrustExpense-" & recTmp(0) & " WHERE EXISTS " & _
                " (SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
                " AND ItemActivity.strDate=Positiondaily.strDate " & _
                " AND ItemActivityDetail.lngItemID=Positiondaily.lngItemID " & _
                " AND ItemActivityDetail.lngPositionID=Positiondaily.lngPositionID " & _
                " AND ItemActivityDetail.strProduceNum=Positiondaily.strProduceNum " & _
                " AND ItemActivityDetail.lngCustomID0=Positiondaily.lngCustomID0 " & _
                " AND ItemActivityDetail.lngCustomID1=Positiondaily.lngCustomID1 " & _
                " AND ItemActivityDetail.lngCustomID2=Positiondaily.lngCustomID2 " & _
                " AND ItemActivityDetail.lngCustomID3=Positiondaily.lngCustomID3 " & _
                " AND ItemActivityDetail.lngCustomID4=Positiondaily.lngCustomID4 " & _
                " AND ItemActivityDetail.lngCustomID5=Positiondaily.lngCustomID5 " & _
                " AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5) & ")"
            If Not gclsBase.ExecSQL(strSQL) Then
                GoTo DeleteErr
            End If

        End If
        If lngActivityTypeID = 1 Then
'            strSql = "SELECT strDate,lngItemID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5)
'            Set recTmp3 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'            If Not (recTmp3.BOF And recTmp3.EOF) Then
'               strSql = "UPDATE ItemDaily2 SET dblPurchaseExpense=dblPurchaseExpense-" & recTmp(0) & " WHERE strDate='" & recTmp3!strDate & "' AND lngItemID=" & recTmp3!lngItemID
'               If Not gclsBase.ExecSQL(strSql) Then
'                  recTmp3.Close
'                  Set recTmp3 = Nothing
'                  GoTo DeleteErr
'               End If
'            End If
'            recTmp3.Close
'            Set recTmp3 = Nothing
            strSQL = "UPDATE ItemDaily2 SET dblPurchaseExpense= dblPurchaseExpense-" & recTmp(0) & " WHERE EXISTS " & _
                " (SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
                " AND ItemActivity.strDate=ItemDaily2.strDate " & _
                " AND ItemActivityDetail.lngItemID=ItemDaily2.lngItemID " & _
                " AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5) & ")"
            If Not gclsBase.ExecSQL(strSQL) Then
                GoTo DeleteErr
            End If
            strSQL = "UPDATE PositionDaily SET dblPurchaseExpense= dblPurchaseExpense-" & recTmp(0) & " WHERE EXISTS " & _
                " (SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
                " AND ItemActivity.strDate=Positiondaily.strDate " & _
                " AND ItemActivityDetail.lngItemID=Positiondaily.lngItemID " & _
                " AND ItemActivityDetail.lngPositionID=Positiondaily.lngPositionID " & _
                " AND ItemActivityDetail.strProduceNum=Positiondaily.strProduceNum " & _
                " AND ItemActivityDetail.lngCustomID0=Positiondaily.lngCustomID0 " & _
                " AND ItemActivityDetail.lngCustomID1=Positiondaily.lngCustomID1 " & _
                " AND ItemActivityDetail.lngCustomID2=Positiondaily.lngCustomID2 " & _
                " AND ItemActivityDetail.lngCustomID3=Positiondaily.lngCustomID3 " & _
                " AND ItemActivityDetail.lngCustomID4=Positiondaily.lngCustomID4 " & _
                " AND ItemActivityDetail.lngCustomID5=Positiondaily.lngCustomID5 " & _
                " AND ItemActivityDetail.lngActivityDetailID=" & recTmp(5) & ")"
            If Not gclsBase.ExecSQL(strSQL) Then
                GoTo DeleteErr
            End If
        End If
        strSQL = "UPDATE ItemActivityDetail SET dblExpenseAmount=dblExpenseAmount-" & recTmp(0) & " WHERE lngActivityDetailID=" & recTmp(5)
        gclsBase.BaseDB.Execute strSQL
        
'        recTmp.Edit
'            recTmp(1) = recTmp(1) - recTmp(0)
'        recTmp.Update
        recTmp.MoveNext
    Loop
    '修改商品表的成本计算标志---------------
    strItemIDList = strItemIDList & " 0 )"
    Dim strModifyItemTable As String
    strModifyItemTable = " UPDATE item SET item.blnIsCalcCost=0 WHERE (item.lngItemID IN " & strItemIDList & ")"
    If gclsBase.ExecSQL(strModifyItemTable) = False Then GoTo DeleteErr
    '--------------------------------------
DDDD:
    strDetailID = strDetailID & " 0 ) "
    If Len(strDetailID) = 6 Then
        GoTo OK
    End If
'删除分摊对照表
    strSQL = "DELETE FROM ExpenseToPurchase " _
           & " WHERE (((ExpenseToPurchase.lngPurchaseActivityDetailID) IN " & strDetailID & ")" & " OR ((ExpenseToPurchase.lngExpenseActivityDetailID) IN " & strDetailID & "))"
    If gclsBase.ExecSQL(strSQL) = False Then GoTo DeleteErr
OK:
    DeleteExpenseToPurchaseDetail = True
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
'    gclsBase.BaseWorkSpace.CommitTrans
    Exit Function
DeleteErr:
    If Not recTmp Is Nothing Then
        Set recTmp = Nothing
    End If
'    gclsBase.BaseWorkSpace.rollbacktrans
    DeleteExpenseToPurchaseDetail = False
End Function

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'直运采购与直运销售对照表(2 -- 12)
Private Function DeletePurchaseToSale() As Integer
    Dim strSQL As String
    Dim recTemp As rdoResultset
    Dim intCount As Integer
    On Error GoTo DeleteErr
    strSQL = " SELECT ItemActivityDetail.lngActivityDetailID FROM ItemActivityDetail " & _
                  " , ItemActivityDetail ItemActivityDetail_1 WHERE ItemActivityDetail.lngActivityDetailID = ItemActivityDetail_1.lngOrderDetailID  " & _
                  " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & "))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    
    If Not recTemp.EOF Then
        If lngActivityTypeID = 1 Then
            cMsgBox strBillNO & strTypeName & "单据已经开票，不能删除、作废！"
        ElseIf lngActivityTypeID = 2 Then
            cMsgBox strBillNO & "直运采购单已发生销售业务，不能删除、作废！"
        ElseIf lngActivityTypeID = 3 Then
            cMsgBox strBillNO & "受托入库单已经结算，不能删除、作废！"
        Else
            cMsgBox strBillNO & "直运采购单已发生销售业务，不能删除、作废！"
        End If
        DeletePurchaseToSale = 0
    Else
        DeletePurchaseToSale = 1
    End If
    recTemp.Close
    Set recTemp = Nothing
    Exit Function
DeleteErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    DeletePurchaseToSale = -1
End Function
'删除采购发票与受托结算单时须标记对应商品入库单及受托入库单
Private Function DeleteInvoiceAndBalance() As Integer
    Dim strSQL As String
    Dim recTemp As rdoResultset
    Dim intCount As Integer
    On Error GoTo DeleteErr
    strSQL = " SELECT ItemActivityDetail.dblSettlementQuantity,ItemActivityDetail.dblCurrSettlementAmount, " & _
                  " ItemActivityDetail.dblInvoiceQuantity,ItemActivityDetail.dblCurrInvoiceAmount,ItemActivityDetail.blnCloseInvoice, " & _
                  "  ItemActivityDetail_1.dblQuantity ,ItemActivityDetail_1.dblCurrAmount,ItemActivityDetail.lngActivityDetailID AS ModifyID " & _
                  "  FROM ItemActivityDetail,ItemActivityDetail ItemActivityDetail_1 " & _
                  " WHERE ItemActivityDetail.lngActivityDetailID = ItemActivityDetail_1.lngOrderDetailID  " & _
                  " AND (((ItemActivityDetail_1.lngActivityID)=" & lngActivityID & "))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    
    If Not recTemp.EOF Then
        With recTemp
            Do While Not recTemp.EOF
'                .Edit
                  strSQL = "UPDATE ItemActivityDetail SET "
                    If lngActivityTypeID = 4 Then  '受托结算
'                        recTemp(0) = recTemp(0) - recTemp(5)
'                        recTemp(1) = recTemp(1) - recTemp(6)
                        strSQL = strSQL & " dblSettlementQuantity=dblSettlementQuantity-" & recTemp(5)
                        strSQL = strSQL & " ,dblCurrSettlementAmount=dblCurrSettlementAmount-" & recTemp(6)
                        strSQL = strSQL & " WHERE lngActivityDetailID=" & recTemp!ModifyID
                        If gclsBase.ExecSQL(strSQL) = False Then
                           GoTo DeleteErr
                        End If
                    ElseIf lngActivityTypeID = 7 Then '采购发票
'                        recTemp(2) = recTemp(2) - recTemp(5)
'                        recTemp(3) = recTemp(3) - recTemp(6)
'                        recTemp(4) = False
                        strSQL = strSQL & " dblInvoiceQuantity=dblInvoiceQuantity-" & recTemp(5)
                        strSQL = strSQL & " AND dblCurrInvoiceAmount=dblCurrInvoiceAmount-" & recTemp(6)
                        strSQL = strSQL & " AND blnCloseInvoice=0 "
                        strSQL = strSQL & " WHERE lngActivityDetailID=" & recTemp!ModifyID
                        If gclsBase.ExecSQL(strSQL) = False Then
                           GoTo DeleteErr
                        End If
                    End If
'                .Update
                .MoveNext
            Loop
        End With
        DeleteInvoiceAndBalance = 1
    Else
        DeleteInvoiceAndBalance = 1
    End If
    recTemp.Close
    Set recTemp = Nothing
    Exit Function
DeleteErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    DeleteInvoiceAndBalance = -1
End Function