listmodule.bas

金算盘软件代码

    strTemp = strTemp & Chr(0) & "字段29=凭证来源,29,1"
    strTemp = strTemp & Chr(0) & "字段30=冲销凭证的来源凭证,30,2"
    strTemp = strTemp & Chr(0) & "字段31=待打印,31,2"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("凭证", strTemp, StrFileName)
    strSql = "SELECT VoucherDetail.*,Voucher.*,Account.strAccountCode,Currencys.strCurrencyCode,Template.strTemplateName" _
        & ",VoucherType.strVoucherTypeCode,Operator.strOperatorName,Operator_1.strOperatorName 审核人" _
        & ",Operator_2.strOperatorName 过帐人,Customer.strCustomerCode,Department.strDepartmentCode" _
        & ",Employee.strEmployeeCode,Class1.strClassCode 统计,Class2.strClassCode 项目" _
        & ",PaymentMethod.strPaymentMethodCode,DECODE(DECODE(Voucher.lngVoucherSourceID,1,1,2,1,0),1," _
        & "Voucher1.intYear || ',' || Voucher1.bytPeriod || ',' || Voucher1.lngVoucherTypeID || ',' || Voucher1.intVoucherNO,'') 冲销凭证" _
        & " FROM VoucherDetail,Voucher,Account,Currencys,VoucherType,Operator,Operator Operator_1,Operator Operator_2," _
        & "Customer,Department,Employee,Class1,Class2,PaymentMethod,Voucher Voucher1,Template"
    
    strSql = strSql _
        & " WHERE ((((((((((((((" _
        & "VoucherDetail.lngVoucherID=Voucher.lngVoucherID) AND " _
        & "VoucherDetail.lngAccountID=Account.lngAccountID) AND " _
        & "VoucherDetail.lngCurrencyID=Currencys.lngCurrencyID) AND " _
        & "Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID) AND " _
        & "Voucher.lngTemplateID=Template.lngTemplateID) AND " _
        & "Voucher.lngOperatorID=Operator.lngOperatorID) AND " _
        & "Voucher.lngCheckerID=Operator_1.lngOperatorID(+)) AND " _
        & "Voucher.lngPostID=Operator_2.lngOperatorID(+)) AND " _
        & "VoucherDetail.lngCustomerID=Customer.lngCustomerID(+)) AND " _
        & "VoucherDetail.lngDepartmentID=Department.lngDepartmentID(+)) AND " _
        & "VoucherDetail.lngEmployeeID=Employee.lngEmployeeID(+)) AND " _
        & "VoucherDetail.lngClassID1=Class1.lngClassID(+)) AND " _
        & "VoucherDetail.lngClassID2=Class2.lngClassID(+)) AND " _
        & "VoucherDetail.lngPaymentMethodID=PaymentMethod.lngPaymentMethodID(+)) AND " _
        & "Voucher.lngSourceVoucherID=Voucher1.lngVoucherID(+) "
    strSql = strSql & " AND Voucher.blnIsVoid=0"
    If strWhere <> "" Then
        strSql = strSql & " AND " & strWhere
    End If
    strSql = strSql & " ORDER BY Voucher.intYear,Voucher.strDate,Voucher.lngVoucherTypeID,Voucher.intVoucherNo,lngRowID"
    
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Dim intVoucherNO As Integer
    With recTemp
        If Dir(strPath & "Voucher.Dat") <> "" Then
            Kill strPath & "Voucher.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "Voucher.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !bytPeriod & Chr(9) & !strDate & Chr(9) & !strVoucherTypeCode _
                & Chr(9) & !intVoucherNO & Chr(9) & !strRemark & Chr(9) & !strAccountCode _
                & Chr(9) & !strCurrencyCode & Chr(9) & !dblRate & Chr(9) & !dblCurrencyAmount _
                & Chr(9) & IIf(!intDirection = 1, !dblAmount, 0) & Chr(9) & IIf(!intDirection = -1, !dblAmount, 0) _
                & Chr(9) & !dblQuantity & Chr(9) & !dblPrice & Chr(9) & !strOperatorName _
                & Chr(9) & !审核人 & Chr(9) & !过帐人 & Chr(9) & !intNumber _
                & Chr(9) & IIf(!lngPostID > 0, 1, 0) & Chr(9) & !strTempLateName _
                & Chr(9) & !lngRowID & Chr(9) & !strCustomerCode & Chr(9) & !strDepartmentCode _
                & Chr(9) & !strEmployeeCode & Chr(9) & !统计 & Chr(9) & !项目 _
                & Chr(9) & !strpaymentMethodCode & Chr(9) & !strCheckNumber & Chr(9) & !dblCurrPaymentAmount _
                & Chr(9) & !lngVoucherSourceID & Chr(9) & !冲销凭证 & Chr(9) & !blnIsPrint & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

'导出科目余额
Private Sub ExportAccountBalance(ByVal StrFileName As String, strWhere As String, _
    ByVal intYear As Integer, ByVal intStartPeriod As Integer, ByVal intEndPeriod As Integer)
End Sub

'导出科目期初
Private Sub ExportAccountInit(ByVal StrFileName As String, strWhere As String, _
    ByVal intYear As Integer, ByVal intStartPeriod As Integer, ByVal intEndPeriod As Integer)
End Sub

'导出应收应付余额
Private Sub ExportRPBalance(ByVal StrFileName As String, strWhere As String, _
    ByVal intYear As Integer, ByVal intStartPeriod As Integer, ByVal intEndPeriod As Integer)
End Sub

'导出银行帐余额
Private Sub ExportBankBalance(ByVal StrFileName As String, strWhere As String, _
    ByVal intYear As Integer, ByVal intStartPeriod As Integer, ByVal intEndPeriod As Integer)
End Sub

'导出银行对帐单
Private Sub ExportBankDetail(ByVal StrFileName As String, strWhere As String)
    Dim strPath As String
    Dim lngResult As Long
    Dim strTemp As String
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim intFileNum As Integer

    strPath = GetFilePath(StrFileName)
    strTemp = "文件名=BankDetail.dat" & Chr(0) & "字段数=11"
    strTemp = strTemp & Chr(0) & "字段1=银行科目,1,2"
    strTemp = strTemp & Chr(0) & "字段2=币种,2,2"
    strTemp = strTemp & Chr(0) & "字段3=日期,3,2"
    strTemp = strTemp & Chr(0) & "字段4=摘要,4,2"
    strTemp = strTemp & Chr(0) & "字段5=方向,5,2"
    strTemp = strTemp & Chr(0) & "字段6=金额,6,1"
    strTemp = strTemp & Chr(0) & "字段7=余额,7,1"
    strTemp = strTemp & Chr(0) & "字段8=付款方法,8,2"
    strTemp = strTemp & Chr(0) & "字段9=票据号,9,2"
    strTemp = strTemp & Chr(0) & "字段10=操作员,10,2"
    strTemp = strTemp & Chr(0) & "字段11=对帐标志,11,3"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("银行对帐单", strTemp, StrFileName)
    strSql = "SELECT BankDetail.*,Account.strAccountCode,Currencys.strCurrencyCode," & _
             "PaymentMethod.strPaymentMethodCode,Operator.strOperatorName from " & _
             "BankDetail,Account,Operator,Currencys,PaymentMethod WHERE BankDetail.lngAccountID=Account.lngAccountID" & _
             " AND BankDetail.lngOperatorID=Operator.lngOperatorID" & _
             " AND BankDetail.lngCurrencyID=Currencys.lngCurrencyID" & _
             " AND BankDetail.lngPaymentMethodID=PaymentMethod.lngPaymentMethodID(+)" _
             & " AND BankDetail.intDirection<>9" '& _
             strofWhere(68)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "BankDetail.Dat") <> "" Then
            Kill strPath & "BankDetail.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "BankDetail.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strAccountCode & Chr(9) & !strCurrencyCode & Chr(9) & !strDate _
                & Chr(9) & !strRemark & Chr(9) & !intDirection & Chr(9) & !dblAmount _
                & Chr(9) & !dblBalance & Chr(9) & !strpaymentMethodCode _
                & Chr(9) & !strCheckNumber & Chr(9) & !strOperatorName _
                & Chr(9) & IIf(!blnIsMatch = True, "1", "0") & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

'导出银行期初
Private Sub ExportBankInit(ByVal StrFileName As String, strWhere As String)
    Dim strPath As String
    Dim lngResult As Long
    Dim strTemp As String
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim intFileNum As Integer

    strPath = GetFilePath(StrFileName)
    strTemp = "文件名=BankInit.dat" & Chr(0) & "字段数=15"
    strTemp = strTemp & Chr(0) & "字段1=银行科目,1,2"
    strTemp = strTemp & Chr(0) & "字段2=币种,2,2"
    strTemp = strTemp & Chr(0) & "字段3=凭证类型,3,2"
    strTemp = strTemp & Chr(0) & "字段4=凭证编号,4,2"
    strTemp = strTemp & Chr(0) & "字段5=单据类型,5,2"
    strTemp = strTemp & Chr(0) & "字段6=单据编号前缀,6,2"
    strTemp = strTemp & Chr(0) & "字段7=单据编号后缀,7,2"
    strTemp = strTemp & Chr(0) & "字段8=日期,8,2"
    strTemp = strTemp & Chr(0) & "字段9=摘要,9,2"
    strTemp = strTemp & Chr(0) & "字段10=方向,10,2"
    strTemp = strTemp & Chr(0) & "字段11=金额,11,1"
    strTemp = strTemp & Chr(0) & "字段12=付款方法,12,2"
    strTemp = strTemp & Chr(0) & "字段13=票据号,13,2"
    strTemp = strTemp & Chr(0) & "字段14=操作员,14,2"
    strTemp = strTemp & Chr(0) & "字段15=对帐标志,15,3"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("银行帐期初", strTemp, StrFileName)
    strSql = "SELECT BankInit.*,ReceiptType.strReceiptTypeName," & _
             "Account.strAccountCode,Currencys.strCurrencyCode," & _
             "VoucherType.strVoucherTypeCode,PaymentMethod.strPaymentMethodCode," & _
             "Operator.strOperatorName from " & _
             "BankInit,Account,Currencys,Operator,VoucherType,ReceiptType,PaymentMethod WHERE BankInit.lngAccountID=Account.lngAccountID " _
             & "AND BankInit.lngCurrencyID=Currencys.lngCurrencyID " _
             & "AND BankInit.lngOperatorID=Operator.lngOperatorID " _
             & "AND BankInit.lngVoucherTypeID=VoucherType.lngVoucherTypeID(+) " _
             & "AND BankInit.lngReceiptTypeID=ReceiptType.lngReceiptTypeID(+) " _
             & "AND BankInit.lngPaymentMethodID=PaymentMethod.lngPaymentMethodID(+) " _
'                 & strofWhere(69)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "BankInit.Dat") <> "" Then
            Kill strPath & "BankInit.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "BankInit.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strAccountCode & Chr(9) & !strCurrencyCode _
                & Chr(9) & !strVoucherTypeCode & Chr(9) & !intVoucherNO _
                & Chr(9) & !strReceiptTypeName & Chr(9) & !strReceiptNo _
                & Chr(9) & !lngReceiptNo & Chr(9) & !strDate & Chr(9) & !strRemark _
                & Chr(9) & !intDirection & Chr(9) & !dblAmount & Chr(9) & !strpaymentMethodCode _
                & Chr(9) & !strCheckNumber & Chr(9) & !strOperatorName _
                & Chr(9) & IIf(!blnIsMatch = True, "1", "0") & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

'导出固资变动记录
'固资增加
'    卡片编号、固资编码、固资名称、规格型号、建造单位、技术特征、经济用途、存放地点、
'    固资类别、使用状态、增加方式、增加日期、部门(...)、科目(...)、币种(...)、累计折旧、折旧方法、
'    预计折旧年限（预计工作量）、工作量单位、净残值、开始使用日期、开始已提折旧期间（开始累计工作量）、
'    按净值提折旧、有累计折旧不作凭证、待打印、最后一期提完折旧、期初、辅助设备(...)
'固资减少
'    固定资产代码、减少日期
'固资变动
'    固资编码、固资名称、规格型号、建造单位、技术特征、经济用途、存放地点、
'    固资类别、使用状态、变动方式、变动日期、部门、科目、币种、累计折旧、折旧方法、
'    预计折旧年限（预计工作量）、工作量单位、净残值、
'    按净值提折旧、有累计折旧不作凭证、待打印、最后一期提完折旧
'blnInit=True 期初，False 发生
Private Sub ExportFixed(ByVal StrFileName As String, strWhere As String, blnInit As Boolean)
    Dim strPath As String
    Dim lngResult As Long
    Dim strTemp As String
    Dim strSql As String
    Dim strFile As String
    Dim strSection As String
    Dim recFixedAlter As rdoResultset
    Dim recFixedDpm As rdoResultset
    Dim recFixedAcc As rdoResultset
    Dim recFixedCost As rdoResultset
    Dim recFixedAux As rdoResultset
    Dim intFileNum As Integer
    Dim strDot As String
    
    If Trim$(strWhere) = "" Then
        strWhere = " 1=1 "
    Else
        strWhere = Replace(strWhere, "WHERE", "")
    End If
    If blnInit Then
        strSection = "固资期初"
        strFile = "FixedInit.dat"
        strWhere = strWhere & " AND FixedAlter.blnIsInit=1"
    Else
        strSection = "固资变动"
        strFile = "FixedAlter.dat"
        strWhere = strWhere & " AND FixedAlter.blnIsInit=0"
    End If
    
    strPath = GetFilePath(StrFileName)
    strTemp = "文件名=" & strFile & Chr(0) & "字段数=30"
    strTemp = strTemp & Chr(0) & "字段1=卡片编号,3,1"
    strTemp = strTemp & Chr(0) & "字段2=固资编码,3,1"
    strTemp = strTemp & Chr(0) & "字段3=固资名称,3,1"
    strTemp = strTemp & Chr(0) & "字段4=规格型号,3,1"
    strTemp = strTemp & Chr(0) & "字段5=建造单位,3,1"
    strTemp = strTemp & Chr(0) & "字段6=技术特征,3,1"
    strTemp = strTemp & Chr(0) & "字段7=经济用途,3,1"
    strTemp = strTemp & Chr(0) & "字段8=存放地点,3,1"
    strTemp = strTemp & Chr(0) & "字段9=固资类别,3,1"
    strTemp = strTemp & Chr(0) & "字段10=使用状态,3,1"
    strTemp = strTemp & Chr(0) & "字段11=增加方式,3,1"
    strTemp = strTemp & Chr(0) & "字段12=增加日期,3,1"
    strTemp = strTemp & Chr(0) & "字段13=使用部门,3,1"
    strTemp = strTemp & Chr(0) & "字段14=费用科目,3,1"
    strTemp = strTemp & Chr(0) & "字段15=币种,3,1"
    strTemp = strTemp & Chr(0) & "字段16=汇率,3,1"
    strTemp = strTemp & Chr(0) & "字段17=原币,3,1"
    strTemp = strTemp & Chr(0) & "字段18=本币,3,1"
    strTemp = strTemp & Chr(0) & "字段19=累计折旧,3,1"
    strTemp = strTemp & Chr(0) & "字段20=折旧方法,3,1"
    strTemp = strTemp & Chr(0) & "字段21=预计折旧年限（预计工作量）,3,1"
    strTemp = strTemp & Chr