frmbasetonew.frm

金算盘软件代码

    Else
        lngAutoID = 1
    End If
    recDetail.Close
    
    strSql = "SELECT lngVoucherTypeID FROM " & mstrNewUser & ".VoucherType WHERE strVoucherFormat='0'"
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recDetail.EOF Then
        lngVoucherTypeID = recDetail!lngVoucherTypeID
    End If
    recDetail.Close
    
    strSql = "SELECT lngReceiptNo,strDate,lngTermID,strReceiptDate,strDueDate,strRemark,lngAccountID," _
        & "lngCustomerID,lngDepartmentID,lngEmployeeID,lngClassID1,lngClassID2,lngCurrencyID,dblRate," _
        & "dblCurrAmount,dblAmount,dblCurrPaymentAmount,intDirection,lngVoucherTypeID,intVoucherNo," _
        & "blnIsReceipt,lngReceiptTypeID " _
        & "FROM Activity,ActivityDetail,Account,Voucher " _
        & "WHERE Activity.lngActivityID = ActivityDetail.lngActivityID " _
        & "AND ActivityDetail.lngAccountID=Account.lngAccountID " _
        & "AND Activity.lngVoucherID=Voucher.lngVoucherID(+) " _
        & "AND ActivityDetail.dblCurrAmount<>ActivityDetail.dblCurrPaymentAmount " _
        & "AND Account.lngAccountNatureID IN (3,4) AND ActivityDetail.dblCurrAmount<>0 " _
        & "AND Activity.strDate<'" & mstrTurnDate & "'"
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recDetail.EOF
        lngReceiptNo = recDetail!lngReceiptNo
        If Not IsNull(recDetail!lngVoucherTypeID) Then
            If recDetail!lngVoucherTypeID > 0 Then
                lngVoucherTypeID = recDetail!lngVoucherTypeID
                lngReceiptNo = recDetail!intVoucherNO
            End If
        End If
        strSql = "INSERT INTO " & mstrNewUser & ".ARAPInit1(lngARAPInitID,lngVoucherTypeID," _
            & "intVoucherNO,strDate,lngTermID,strReceiptDate,strDueDate,strRemark," _
            & "lngAccountID,lngCustomerID,lngDepartmentID,lngEmployeeID,lngClassID1," _
            & "lngClassID2,lngCurrencyID,dblRate,dblCurrAmount,dblAmount,dblCurrPaymentAmount," _
            & "intDirection VALUES(" & lngAutoID & "," & lngVoucherTypeID & "," & lngReceiptNo & "," _
            & recDetail!strDate & "," & recDetail!lngTermID & "," _
            & IIf(IsDate(recDetail!strReceiptDate), recDetail!strReceiptDate, recDetail!strDate) & "," _
            & IIf(IsDate(recDetail!strDueDate), recDetail!strDueDate, recDetail!strDate) & "," _
            & recDetail!strRemark & "," & recDetail!lngAccountID & "," & recDetail!lngCustomerID & "," _
            & recDetail!lngDepartmentID & "," & recDetail!lngEmployeeID & "," & recDetail!lngClassID1 & "," _
            & recDetail!lngClassID2 & "," & recDetail!lngCurrencyID & "," & recDetail!dblRate & "," _
            & recDetail!dblCurrAmount - recDetail!dblCurrPaymentAmount & "," _
            & Format(recDetail!dblAmount * (recDetail!dblCurrAmount - recDetail!dblCurrPaymentAmount) / recDetail!dblCurrAmount, "0.00") & "," _
            & 0 & ","
        If recDetail!blnIsReceipt = 1 And (recDetail!lngReceiptTypeID = 39 Or recDetail!lngReceiptTypeID = 36 Or recDetail!lngReceiptTypeID = 35) _
            Or recDetail!blnIsReceipt = 0 And (recDetail!lngReceiptTypeID = 40 Or recDetail!lngReceiptTypeID = 34 Or recDetail!lngReceiptTypeID = 37) Then
            strSql = strSql & "1)"
        Else
            strSql = strSql & "-1)"
        End If
        gclsBase.ExecSQL strSql
        recDetail.MoveNext
    Loop
    recDetail.Close
    Set recDetail = Nothing
End Function

Private Function VoucherDataToInit() As Boolean
    Dim strSql As String
    Dim recDetail As rdoResultset
    Dim lngVoucherTypeID As Long
    Dim lngReceiptNo As Long
    Dim lngAutoID As Long
    
    strSql = "SELECT Max(lngARAPInitID) As lngID FROM " & mstrNewUser & ".ARAPInit1"
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recDetail.EOF Then
        lngAutoID = recDetail!lngID
    Else
        lngAutoID = 1
    End If
    recDetail.Close
    
    strSql = "SELECT strDate,lngVoucherTypeID,intVoucherNo,strRemark,lngAccountID," _
        & "lngCustomerID,lngDepartmentID,lngEmployeeID,lngClassID1,lngClassID2,lngCurrencyID,dblRate," _
        & "dblCurrAmount,dblAmount,dblCurrPaymentAmount,intDirection " _
        & "Voucher,VoucherDetail,Account " _
        & "WHERE Voucher.lngVoucherID = VoucherDetail.lngVoucherID) " _
        & "AND VoucherDetail.lngAccountID=Account.lngAccountID " _
        & "AND dblCurrencyAmount<>dblCurrPaymentAmount AND recDetail!dblCurrencyAmount<>0 " _
        & "AND Account.lngAccountNatureID IN (3,4) " _
        & "AND lngVoucherSourceID IN (1,2,4,12,13,14,15,16) " _
        & "AND strDate<'" & mstrTurnDate & "'"
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recDetail.EOF
        strSql = "INSERT INTO " & mstrNewUser & ".ARAPInit1(lngARAPInitID,lngVoucherTypeID," _
            & "intVoucherNO,strDate,lngTermID,strReceiptDate,strDueDate,strRemark," _
            & "lngAccountID,lngCustomerID,lngDepartmentID,lngEmployeeID,lngClassID1," _
            & "lngClassID2,lngCurrencyID,dblRate,dblCurrAmount,dblAmount,dblCurrPaymentAmount," _
            & "intDirection VALUES(" & lngAutoID & "," & recDetail!lngVoucherTypeID & "," _
            & recDetail!intVoucherNO & "," & recDetail!strDate & "," & 0 & "," _
            & recDetail!strDate & "," & recDetail!strDate & "," & recDetail!strRemark & "," _
            & recDetail!lngAccountID & "," & recDetail!lngCustomerID & "," _
            & recDetail!lngDepartmentID & "," & recDetail!lngEmployeeID & "," & recDetail!lngClassID1 & "," _
            & recDetail!lngClassID2 & "," & recDetail!lngCurrencyID & "," & recDetail!dblRate & "," _
            & recDetail!dblCurrencyAmount - recDetail!dblCurrPaymentAmount & "," _
            & Format(recDetail!dblAmount * (recDetail!dblCurrencyAmount - recDetail!dblCurrPaymentAmount) / recDetail!dblCurrAmount, "0.00") & "," _
            & 0 & "," & recDetail!intDirection & ")"
        gclsBase.ExecSQL strSql
        recDetail.MoveNext
    Loop
    recDetail.Close
    Set recDetail = Nothing
End Function

Private Sub AddAccountBalance()
    Dim strSql As String
    Dim recOld As rdoResultset
    
    strSql = TransferPublic.getQInitAccountBalanceOraSql
    strSql = Replace(strSql, "[EndDate]", "'" & mstrTurnDate & "'")
    
    Set recOld = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recOld.EOF
        strSql = "INSERT INTO " & mstrNewUser & ".AccountBalance(" _
            & "lngAccountID,lngCurrencyID,lngClassID1,lngClassID2," _
            & "lngCustomerID,lngDepartmentID,lngEmployeeID," _
            & "dblUnVoucherInit,dblPostedInit," _
            & "dblCurrencyUnVoucherInit,dblCurrencyPostedInit," _
            & "dblQuantityUnVoucherInit,dblQuantityPostedInit) " _
            & "VALUES(" & recOld!lngAccountID & "," & recOld!lngCurrencyID & "," _
            & recOld!lngClassID1 & "," & recOld!lngClassID2 & "," _
            & recOld!lngCustomerID & "," & recOld!lngDepartmentID & "," _
            & recOld!lngEmployeeID & "," & recOld!dblUnVoucherInit & "," _
            & recOld!dblPostedInit & "," & recOld!dblCurrencyUnVoucherInit & "," _
            & recOld!dblCurrencyPostedInit & "," & recOld!dblQuantityUnVoucherInit & "," _
            & recOld!dblQuantityPostedInit & ") "
        gclsBase.ExecSQL strSql
        recOld.MoveNext
    Loop
    recOld.Close
    Set recOld = Nothing
End Sub

Private Sub AddBankInit()
    Dim strSql As String
    Dim recDetail As rdoResultset
    Dim recBank As rdoResultset
    Dim dblBalance As Double
    
    strSql = "DELETE FROM " & mstrNewUser & ".BankInfo"
    gclsBase.ExecSQL strSql
    strSql = "INSERT INTO " & mstrNewUser & ".BankInfo SELECT * FROM " & mstrOldUser & ".BankInfo"
    gclsBase.ExecSQL strSql
    strSql = "UPDATE " & mstrNewUser & "BankInfo SET strStartDate='" & mstrTurnDate & "' " _
        & "WHERE strStartDate<'" & mstrTurnDate & "' "
    gclsBase.ExecSQL strSql
    
    strSql = "SELECT ActivityDetail.lngAccountID,ActivityDetail.lngCurrencyID,lngReceiptTypeID,strReceiptNo,lngReceiptNo," _
        & "strDate,lngActivityTypeID,strRemark,dblAmount,lngPaymentMethodID,strCheckNumber,lngOperatorID,blnIsReceipt " _
        & "FROM " & mstrOldUser & ".ActivityDetail," & mstrOldUser & ".Activity," & mstrOldUser & ".BankInfo " _
        & "WHERE ActivityDetail.lngActivityID=Activity.lngActivityID " _
        & "AND ActivityDetail.lngAccountID=BankInfo.lngAccountID " _
        & "AND Activity.blnIsVoid=0 AND ActivityDetail.blnIsClosed=0 " _
        & "AND Activity.lngActivityTypeID IN (39,40) AND Activity.strDate<'" & mstrTurnDate & "'"
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recDetail
        Do While Not .EOF
            strSql = "INSERT INTO BankInit(lngAccountID,lngCurrencyID,lngReceiptTypeID," _
                & "strReceiptNo,lngReceiptNo,strDate,strRemark,intDirection,dblAmount," _
                & "lngPaymentMethodID,strCheckNumber,lngOperatorID) " _
                & "VALUES(" & !lngAccountID & "," & !lngCurrencyID & "," & !lngReceiptTypeID & ",'" _
                & !strReceiptNo & "'," & !lngReceiptNo & ",'" & !strDate & "','" & !strRemark & "'," _
                & IIf(!lngActivityTypeID = 39 And !blnIsReceipt = 1 Or !lngActivityTypeID = 40 And !blnIsReceipt = 0, -1, 1) & "," _
                & !dblAmount & "," & !lngPaymentMethodID & ",'" _
                & !strCheckNumber & "'," & !lngOperatorID & ")"
            gclsBase.ExecSQL strSql
            .MoveNext
        Loop
    End With
    recDetail.Close
    
'    If Not mblnControlAccount Then
    If True Then
        strSql = "SELECT VoucherDetail.lngAccountID,VoucherDetail.lngCurrencyID,lngVoucherTypeID,intVoucherNO,strDate,strRemark," _
            & "intDirection,dblAmount,lngPaymentMethodID,strCheckNumber,lngOperatorID " _
            & "FROM " & mstrOldUser & ".VoucherDetail," & mstrOldUser & ".Voucher," & mstrOldUser & ".BankInfo " _
            & "WHERE VoucherDetail.lngVoucherID=Voucher.lngVoucherID " _
            & "AND VoucherDetail.lngAccountID=BankInfo.lngAccountID " _
            & "AND Voucher.blnIsVoid=0 AND VoucherDetail.blnIsClosed=0 " _
            & "AND lngVoucherSourceID<>7 AND lngVoucherSourceID<>8 " _
            & "AND Voucher.strDate<'" & mstrTurnDate & "'"
        Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        With recDetail
            Do While Not .EOF
                strSql = "INSERT INTO BankInit(lngAccountID,lngCurrencyID,lngVoucherTypeID,lngReceiptTypeID," _
                    & "strReceiptNo,intVoucherNo,strDate,strRemark,intDirection,dblAmount," _
                    & "lngPaymentMethodID,strCheckNumber,lngOperatorID) " _
                    & "VALUES(" & !lngAccountID & "," & !lngCurrencyID & "," & !lngVoucherTypeID & "," & 41 & ",'" _
                    & "" & "'," & !intVoucherNO & ",'" & !strDate & "','" & !strRemark & "'," _
                    & !intDirection & "," & !dblAmount & "," & !lngPaymentMethodID & ",'" _
                    & !strCheckNumber & "'," & !lngOperatorID & ")"
                gclsBase.ExecSQL strSql
                .MoveNext
            Loop
        End With
    End If
    recDetail.Close
    Set recDetail = Nothing
    
    strSql = "SELECT * FROM BankInfo"
    Set recBank = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recBank.EOF
        '对帐单
        strSql = "SELECT dblBalance FROM " & mstrOldUser & ".BankDetail " _
            & "WHERE strDate<'" & mstrTurnDate & "' AND lngAccountID=" & recBank!lngAccountID _
            & " AND lngCurrencyID=" & recBank!lngCurrencyID _
            & " ORDER BY strDate DESC,lngBankDetailID DESC"
        Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recDetail.EOF Then
            dblBalance = 0
        Else
            dblBalance = recDetail!dblBalance
        End If
        recDetail.Close
        
        strSql = "INSERT INTO " & mstrNewUser & ".BankDetail SELECT * FROM " & mstrOldUser & ".BankDetail " _
            & "WHERE lngAccountID=" & recBank!lngAccountID & " AND lngCurrencyID=" & recBank!lngCurrencyID _
            & " AND (strRemark='期初余额' OR blnIsMatch=1 AND strDate<'" & mstrTurnDate & "')"
        gclsBase.ExecSQL strSql
        
        strSql = "INSERT INTO " & mstrNewUser & ".BankDetail(lngAccountID,lngCurrencyID,strRemark,strDate,intDirection,dblBalance,lngOperatorID) " _
            & "VALUES(" & recBank!lngAccountID & "," & recBank!lngCurrencyID & ",'期初余额','" _
            & Format(CDate(mstrTurnDate) - 1, "yyyy-mm-dd") & "',9," & dblBalance & "," & gclsBase.OperatorID & ")"
        gclsBase.ExecSQL strSql
        
        '银行帐
        strSql = "SELECT SUM(intDirection*dblAmount) As dblBalance FROM " & mstrOldUser & ".BankInit WHERE strDate<'" & mstrTurnDate & "' " _
            & "AND lngAccountID=" & recBank!lngAccountID & " AND lngCurrencyID=" & recBank!lngCurrencyID
        Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recDetail.EOF Then
            dblBalance = 0
        Else
            dblBalance = Format(recDetail!dblBalance, "@;0")
        End If
        recDetail.Close
        
        strSql = "INSERT INTO " & mstrNewUser & ".BankInit SELECT * FROM " & mstrOldUser & ".BankInit " _
            & "WHERE lngAccountID=" & recBank!lngAccountID & " AND lngCurrencyID=" & recBank!lngCurrencyID _
            & " AND blnIsMatch=1 AND strDate<'" & mstrTurnDate & "'"
        gclsBase.ExecSQL strSql
        
        recBank.MoveNext
    Loop
    recBank.Close
    Set recBank = Nothing
    Set recDetail = Nothing
End Sub