clsstocktaking.cls

金算盘软件代码

'    Loop
'    recTmp.Close
'    Set recTmp = Nothing
    DeletePositionItemDetail = 1
    Exit Function
DeleteErr:
    DeletePositionItemDetail = -1
End Function

'改变Item中的 最近采购单据子表ID、最高采购价格单据子表ID、最低采购价格单据子表ID、最近采购价格、最高采购价格、最底采购价格
Private Function ChangeItemInfo() As Integer
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim recTemp_1 As rdoResultset
    Dim lngActivityDetailID As Long
    Dim lngItemID As Long
    Dim lngTempID As Long
    Dim dblTempPrice As Double
    Dim dblQuantity As Double
    Dim lngPositionID As Long
    Dim dblCurrPrice_Temp As Double
    On Error GoTo TheErr

    strSql = "SELECT ItemActivityDetail.lngActivityDetailID, ItemActivityDetail.lngItemID, ItemActivityDetail.dblQuantity, " _
           & " Item.lngRecentPurchaseDetailID," _
           & " Item.lngMaxPurchasePriceDetailID," _
           & " Item.lngMinPurchasePriceDetailID," _
           & " Item.dblRecenetPurchasePrice," _
           & " Item.dblMaxPurchasePrice," _
           & " Item.dblMinPurchasePrice,Item.lngItemID AS ModifyID" _
           & " FROM Item ,ItemActivityDetail where Item.lngItemID = ItemActivityDetail.lngItemID" _
           & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & ")) ORDER BY ItemActivityDetail.lngItemID "
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
'        cMsgBox "不能从数据库中找到" & strBillNO & strTypeName & "单据中的商品，删除失败！"
        Exit Function
    End If
    With recTemp
        .MoveFirst
        Do While Not .EOF
            lngActivityDetailID = .rdoColumns(0)
            lngItemID = .rdoColumns(1)
            dblQuantity = .rdoColumns(2)
            
            '1)
            If .rdoColumns(0) = .rdoColumns(3) Then '当前ID是最近采购单据子表ID
                strSql = "SELECT Max(ItemActivityDetail.lngActivityDetailID) AS 表达式1" _
                       & " FROM ItemActivity , ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID" _
                       & " AND (((ItemActivity.lngActivityTypeID)=1) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>" & lngActivityDetailID & "))"
                Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'                .Edit
                If (recTemp_1.BOF And recTemp_1.EOF) Or (IsNull(recTemp_1(0))) Then
                     
'                    .rdoColumns(3) = 0
'                    .rdoColumns(6) = 0
                     strSql = "UPDATE Item SET "
                     strSql = strSql & " lngRecentPurchaseDetailID=0 , dblRecenetPurchasePrice=0 "
                     strSql = strSql & " WHERE lngItemID=" & !ModifyID
                     If gclsBase.ExecSQL(strSql) = False Then
                        GoTo TheErr
                     End If
                Else
                    lngTempID = recTemp_1(0) '新的最近采购单据子表ID
                    Set recTemp_1 = Nothing
                    strSql = "SELECT ItemActivityDetail.dblCurrPrice From ItemActivityDetail WHERE (ItemActivityDetail.lngActivityDetailID)=" & lngTempID
                    Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recTemp_1.BOF And recTemp_1.EOF Then Exit Function
                    
'                    .rdoColumns(3) = lngTempID
'                    .rdoColumns(6) = recTemp_1(0)     '最近采购价
                    strSql = "UPDATE Item SET "
                    strSql = strSql & " lngRecentPurchaseDetailID=" & lngTempID & " , dblRecenetPurchasePrice=" & recTemp_1(0)
                    strSql = strSql & " WHERE lngItemID=" & !ModifyID
                    Set recTemp_1 = Nothing
                     If gclsBase.ExecSQL(strSql) = False Then
                        GoTo TheErr
                     End If
                End If
'                .Update
            End If
            '2)
            If .rdoColumns(0) = .rdoColumns(4) Then '当前ID是最高采购价格单据子表ID
                strSql = "SELECT Max(ItemActivityDetail.dblCurrPrice) AS 表达式1" _
                       & " FROM ItemActivity , ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID" _
                       & " AND (((ItemActivity.lngActivityTypeID)=1) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>" & lngActivityDetailID & "))"
                Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'                .Edit
                If (recTemp_1.BOF And recTemp_1.EOF) Or (IsNull(recTemp_1(0))) Then
'                    .rdoColumns(4) = 0
'                    .rdoColumns(7) = 0
                     strSql = "UPDATE Item SET "
                     strSql = strSql & " lngMaxPurchaseDetailID=0 , dblMaxPurchasePrice=0 "
                     strSql = strSql & " WHERE lngItemID=" & !ModifyID
                     If gclsBase.ExecSQL(strSql) = False Then
                        GoTo TheErr
                     End If
                Else
                    '通过最高价查找ID
                    dblCurrPrice_Temp = recTemp_1(0)
                    Set recTemp_1 = Nothing
                    strSql = "SELECT ItemActivityDetail.lngActivityDetailID " _
                           & " FROM ItemActivity , ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " _
                           & " AND (((ItemActivityDetail.dblCurrPrice)=" & dblCurrPrice_Temp & ") AND ((ItemActivity.lngActivityTypeID)=1) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>36))"
                    Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recTemp_1.BOF And recTemp.EOF Then Exit Function
                    
'                    .rdoColumns(4) = recTemp_1(0)
'                    .rdoColumns(7) = dblCurrPrice_Temp
                    strSql = "UPDATE Item SET "
                    strSql = strSql & " lngMaxPurchaseDetailID=" & recTemp_1(0) & " , dblMaxPurchasePrice=" & dblCurrPrice_Temp
                    strSql = strSql & " WHERE lngItemID=" & !ModifyID
                    Set recTemp_1 = Nothing
                     If gclsBase.ExecSQL(strSql) = False Then
                        GoTo TheErr
                     End If
                End If
'                .Update
            End If
            '3)
            If .rdoColumns(0) = .rdoColumns(5) Then '当前ID是最低采购价格单据子表ID
                strSql = "SELECT Min(ItemActivityDetail.dblCurrPrice) AS 表达式1" _
                       & " FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID" _
                       & " AND (((ItemActivity.lngActivityTypeID)=1) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>" & lngActivityDetailID & "))"
                Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'                .Edit
                If (recTemp_1.BOF And recTemp_1.EOF) Or (IsNull(recTemp_1(0))) Then
'                    .rdoColumns(5) = 0
'                    .rdoColumns(8) = 0
                     strSql = "UPDATE Item SET "
                     strSql = strSql & " lngMinPurchaseDetailID=0 , dblMinPurchasePrice=0 "
                     strSql = strSql & " WHERE lngItemID=" & !ModifyID
                     If gclsBase.ExecSQL(strSql) = False Then
                        GoTo TheErr
                     End If
                Else
                    '通过最低价查找ID
                    dblCurrPrice_Temp = recTemp_1(0)
                    Set recTemp_1 = Nothing
                    strSql = "SELECT ItemActivityDetail.lngActivityDetailID " _
                           & " FROM ItemActivity , ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " _
                           & " AND (((ItemActivityDetail.dblCurrPrice)=" & dblCurrPrice_Temp & ") AND ((ItemActivity.lngActivityTypeID)=1) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>36))"
                    Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recTemp_1.BOF And recTemp.EOF Then Exit Function
                            
'                    .rdoColumns(5) = recTemp_1(0)
'                    .rdoColumns(8) = dblCurrPrice_Temp
                    strSql = "UPDATE Item SET "
                    strSql = strSql & " lngMinPurchaseDetailID=" & recTemp_1(0) & " , dblMinPurchasePrice=" & dblCurrPrice_Temp
                    strSql = strSql & " WHERE lngItemID=" & !ModifyID
                    Set recTemp_1 = Nothing
                     If gclsBase.ExecSQL(strSql) = False Then
                        GoTo TheErr
                     End If

                End If
'                .Update
            End If
            .MoveNext
        Loop
    End With
    ChangeItemInfo = 1
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    If Not recTemp_1 Is Nothing Then
        Set recTemp_1 = Nothing
    End If
    Exit Function
TheErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    If Not recTemp_1 Is Nothing Then
        Set recTemp_1 = Nothing
    End If
    ChangeItemInfo = -1
End Function


'商品成本资料明细
'商品性质表中存在：成本方法
Private Function DeleteItemCostDetail() As Integer
    Dim strSql As String
'    Dim recTmp As rdoResultset
    DeleteItemCostDetail = 1
    
    Select Case lngActivityTypeID
        Case 9, 10
            strSql = "DELETE FROM ItemCostDetail WHERE ItemCostDetail.lngInActivityDetailID IN " & _
                " (SELECT ItemActivityDetail.lngActivityDetailID FROM ItemActivityDetail " & _
                " WHERE ItemActivityDetail.lngActivityID=" & lngActivityID & ")"
            If gclsBase.ExecSQL(strSql) = False Then DeleteItemCostDetail = -1
'''            strSql = "SELECT ItemCostDetail.lngItemID,ItemCostDetail.lngInActivityDetailID," _
'''                   & " ItemCostDetail.lngOutActivityDetailID,ItemCostDetail.dblQuantity,ItemCostDetail.dblAmount " _
'''                   & " FROM ItemCostDetail,ItemActivityDetail WHERE ItemCostDetail.lngInActivityDetailID = ItemActivityDetail.lngActivityDetailID " _
'''                   & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & "))"
'''            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'''            Do While Not recTmp.EOF
'''               strSql = "DELETE ItemCostDetail WHERE lngItemID=" & recTmp(0) & " AND lngInActivityDetailID=" & recTmp(1) _
'''                  & " AND lngOutActivityDetailID=" & recTmp(2) & " AND dblQuantity=" & recTmp(3) & " AND dblAmount=" & recTmp(4)
'''               If gclsBase.ExecSQL(strSql) = False Then
'''                  recTmp.Close
'''                  Set recTmp = Nothing
'''                  DeleteItemCostDetail = -1
'''                  Exit Do
'''               End If
'''               recTmp.MoveNext
'''            Loop
'''            recTmp.Close
'''            Set recTmp = Nothing
        Case Else
            strSql = "DELETE FROM ItemCostDetail WHERE ItemCostDetail.lngOutActivityDetailID IN " & _
                " (SELECT ItemActivityDetail.lngActivityDetailID FROM ItemActivityDetail " & _
                " WHERE ItemActivityDetail.lngActivityID=1" & lngActivityID & ")"
            If gclsBase.ExecSQL(strSql) = False Then DeleteItemCostDetail = -1
'''            strSql = "SELECT ItemCostDetail.lngItemID,ItemCostDetail.lngInActivityDetailID," _
'''                   & " ItemCostDetail.lngOutActivityDetailID,ItemCostDetail.dblQuantity,ItemCostDetail.dblAmount " _
'''                   & " FROM ItemCostDetail,ItemActivityDetail WHERE ItemCostDetail.lngOutActivityDetailID = ItemActivityDetail.lngActivityDetailID " _
'''                   & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & "))"
'''            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'''            Do While Not recTmp.EOF
'''               strSql = "DELETE ItemCostDetail WHERE lngItemID=" & recTmp(0) & " AND lngInActivityDetailID=" & recTmp(1) _
'''                  & " AND lngOutActivityDetailID=" & recTmp(2) & " AND dblQuantity=" & recTmp(3) & " AND dblAmount=" & recTmp(4)
'''               If gclsBase.ExecSQL(strSql) = False Then
'''                  recTmp.Close
'''                  Set recTmp = Nothing
'''                  DeleteItemCostDetail = -1
'''                  Exit Do
'''               End If
'''               recTmp.MoveNext
'''            Loop
'''            recTmp.Close
'''            Set recTmp = Nothing
    End Select
End Function

'//////////////////////////////////////结束：对照表处理////////////////////////////////////////////////////


'<接口>
'blnByVoid：删除功能由作废调用
Private Function DeletePurchase(arglngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim intResult As Integer
    lngActivityID = arglngActivityID
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    On Error GoTo DeleteErr
    '------------------------------------------
    strSql = "SELECT ItemActivity.lngActivityTypeID, ItemActivity.blnIsVoid, Decode(ItemActivity.lngActivityTypeID,1,'商品采购',2,'直运采购',3,'受托入库',4,'受托结算',5,'加工入库',6,'加工费用',7,'采购发票',8,'自制入库',9,'盘盈入库',10,'其他入库') AS 采购类型 ,ItemActivity.* From ItemActivity WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        DeletePurchase = True
        Set recTemp = Nothing
        Exit Function
    End If
    lngActivityTypeID = recTemp(0)
    blnIsVoid = (recTemp(1) <> 0)
    strTypeName = recTemp(2)
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
    lngReceiptTypeID = recTemp!lngReceiptTypeID
    strReceiptNo = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    '--------------------------------------------------------------------
    Set recTemp = Nothing

    '删除作废单据无须判断
'    On Error GoTo DeleteErr
    gclsBase.BaseWorkSpace.BeginTrans
        
    '1）单据是作废单据，不执行c
    If Not blnIsVoid Then
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If ChangeAllAccount_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If DeleteObtendTables() <> 1 Then GoTo DeleteErr
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo DeleteErr
    Else
        If gclsBase.ExecSQL("UPDATE ItemActivity SET  ItemActivity.blnIsVoid = 1 WHERE (((ItemActivity.lngActivityID)=" & lngActivityID & "));") = False Then GoTo DeleteErr
    End If