listmodule.bas

金算盘软件代码

                & Chr(9) & !strOfficePhone & Chr(9) & !strHomePhone _
                & Chr(9) & !strBirthdate & Chr(9) & !strNotes _
                & Chr(9) & !strCardNo & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportClass1(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 = "文件名=Class1.dat" & Chr(0) & "字段数=6"
    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,1"
    strTemp = strTemp & Chr(0) & "字段5=末级标志,5,3"
    strTemp = strTemp & Chr(0) & "字段6=备注,6,2"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("统计核算", strTemp, StrFileName)
    strSql = "Select * From Class1" & strWhere & " ORDER BY strClassCode"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "Class1.Dat") <> "" Then
            Kill strPath & "Class1.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "Class1.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strClassCode & Chr(9) & !strClassName _
                & Chr(9) & !strFullName _
                & Chr(9) & !intLevel _
                & Chr(9) & IIf(!blnIsDetail, "1", "0") _
                & Chr(9) & !strNotes _
                & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportClass2(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 = "文件名=Class2.dat" & Chr(0) & "字段数=6"
    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,1"
    strTemp = strTemp & Chr(0) & "字段5=末级标志,5,3"
    strTemp = strTemp & Chr(0) & "字段6=备注,6,2"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("项目核算", strTemp, StrFileName)
    strSql = "Select * From Class2" & strWhere & " ORDER BY strClassCode"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "Class2.Dat") <> "" Then
            Kill strPath & "Class2.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "Class2.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strClassCode & Chr(9) & !strClassName _
                & Chr(9) & !strFullName _
                & Chr(9) & !intLevel _
                & Chr(9) & IIf(!blnIsDetail, "1", "0") _
                & Chr(9) & !strNotes _
                & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportItemNature(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 = "文件名=ItemNature.dat" & Chr(0) & "字段数=9"
    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) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("商品性质", strTemp, StrFileName)
    strSql = "SELECT *,Tax.strTaxName,Account.strAccountCode AS 收入科目,Account1.strAccountCode AS 成本科目," _
        & "Account2.strAccountCode AS 存货科目,Account3.strAccountCode AS 差异科目,Account4.strAccountCode " _
        & "AS 待实现销项税科目 FROM ItemNature,Tax,Account,Account Account1,Account Account2," _
        & "Account Account3,Account Account4 WHERE ItemNature.lngTaxID=Tax.lngTaxID" _
        & " AND ItemNature.lngSaleAccountID=Account.lngAccountID(+)" _
        & " AND ItemNature.lngCostAccountID=Account1.lngAccountID(+)" _
        & " AND ItemNature.lngStockAccountID=Account2.lngAccountID(+)" _
        & " AND ItemNature.lngDiffAccountID=Account3.lngAccountID(+)" _
        & " AND ItemNature.lngStockTaxAccountID=Account4.lngAccountID(+)" _
        & strWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "ItemNature.Dat") <> "" Then
            Kill strPath & "ItemNature.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "ItemNature.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strItemNatureName & Chr(9) & !strItemCategory _
                & Chr(9) & !strTaxName & Chr(9) & !收入科目 & Chr(9) & !成本科目 & Chr(9) _
                & !存货科目 & Chr(9) & !差异科目 & Chr(9) & !待实现销项税科目 _
                & Chr(9) & !strCostMethod & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportItemType(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 = "文件名=ItemType.dat" & Chr(0) & "字段数=3"
    strTemp = strTemp & Chr(0) & "字段1=商品类别编码,1,2"
    strTemp = strTemp & Chr(0) & "字段2=商品类别名称,2,2"
    strTemp = strTemp & Chr(0) & "字段3=封存标志,3,3"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("商品类别", strTemp, StrFileName)
    strSql = "SELECT * FROM ItemType" & strWhere & " ORDER BY strItemTypeCode"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "ItemType.Dat") <> "" Then
            Kill strPath & "ItemType.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "ItemType.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strItemTypeCode & Chr(9) & !strItemTypeName _
                & Chr(9) & IIf(!blnIsInActive, "1", "0") & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportItem(ByVal StrFileName As String, strWhere As String)
    Dim recUnit As rdoResultset
    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 = "文件名=Item.dat" & Chr(0) & "字段数=34"
    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,3"
    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,3"
    strTemp = strTemp & Chr(0) & "字段11=供应商,11,1"
    strTemp = strTemp & Chr(0) & "字段12=商品货号,12,2"
    strTemp = strTemp & Chr(0) & "字段13=最小库存量,13,1"
    strTemp = strTemp & Chr(0) & "字段14=最大库存量,14,1"
    strTemp = strTemp & Chr(0) & "字段15=提前时间,15,1"
    strTemp = strTemp & Chr(0) & "字段16=含税采购价,16,1"
    strTemp = strTemp & Chr(0) & "字段17=不含税采购价,17,1"
    strTemp = strTemp & Chr(0) & "字段18=含税销售价,18,1"
    strTemp = strTemp & Chr(0) & "字段19=不含税销售价,19,1"
    strTemp = strTemp & Chr(0) & "字段20=不含税计划价,20,1"
    strTemp = strTemp & Chr(0) & "字段21=含税零售价,21,1"
    strTemp = strTemp & Chr(0) & "字段22=保值期,22,1"
    strTemp = strTemp & Chr(0) & "字段23=批次管理标志,23,3"
    strTemp = strTemp & Chr(0) & "字段24=组件商品标志,24,3"
    strTemp = strTemp & Chr(0) & "字段25=组装标志,25,3"
    strTemp = strTemp & Chr(0) & "字段26=受托商品标志,26,3"
    strTemp = strTemp & Chr(0) & "字段27=备注,27,2"
    strTemp = strTemp & Chr(0) & "字段28=自定项目0,28,2"
    strTemp = strTemp & Chr(0) & "字段29=自定项目1,29,2"
    strTemp = strTemp & Chr(0) & "字段30=自定项目2,30,2"
    strTemp = strTemp & Chr(0) & "字段31=自定项目3,31,2"
    strTemp = strTemp & Chr(0) & "字段32=自定项目4,32,2"
    strTemp = strTemp & Chr(0) & "字段33=自定项目5,33,2"
    strTemp = strTemp & Chr(0) & "字段34=库存量,34,1"
    strTemp = strTemp & Chr(0) & "字段35=计量单位,35,2"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("商品", strTemp, StrFileName)
    
    strSql = "SELECT Item.*,ItemNature.strItemNatureName,ItemType.strItemTypeCode,ItemUnit.strUnitName AS 最小计量单位," _
        & "Im.strUnitName AS 存货计量单位,Position.strPositionCode,Area.strAreaCode,Customer.strCustomerCode," _
        & "Custom0.strCustomCode As 自定义项目0,Custom1.strCustomCode As 自定义项目1,Custom2.strCustomCode As 自定义项目2," _
        & "Custom3.strCustomCode As 自定义项目3,Custom4.strCustomCode As 自定义项目4,Custom5.strCustomCode As 自定义项目5 " _
        & "FROM Item,ItemNature,ItemType,ItemUnit,ItemUnit Im,Position,Area,Customer,Custom0,Custom1,Custom2,Custom3,Custom4,Custom5 " _
        & "WHERE Item.lngItemNatureID=ItemNature.lngItemNatureID AND " _
        & "Item.lngItemTypeID=ItemType.lngItemTypeID AND " _
        & "Item.lngMinUnitID=ItemUnit.lngUnitID AND " _
        & "Item.lngStockUnitID=Im.lngUnitID AND " _
        & "Item.lngPositionID=Position.lngPositionID(+) AND " _
        & "Item.lngAreaID=Area.lngAreaID(+) AND " _
        & "Item.lngCustomerID=Customer.lngCustomerID(+) AND " _
        & "Item.lngCustomID0=Custom0.lngCustomID(+) AND " _
        & "Item.lngCustomID1=Custom1.lngCustomID(+) AND " _
        & "Item.lngCustomID2=Custom2.lngCustomID(+) AND " _
        & "Item.lngCustomID3=Custom3.lngCustomID(+) AND " _
        & "Item.lngCustomID4=Custom4.lngCustomID(+) AND " _
        & "Item.lngCustomID5=Custom5.lngCustomID(+)" & strWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "Item.Dat") <> "" Then
            Kill strPath & "Item.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "Item.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strItemCode & Chr(9) & !strItemName & Chr(9) & !strItemStyle _
                & Chr(9) & IIf(!blnIsInActive, "1", "0") & Chr(9) & !strItemNatureName _
                & Chr(9) & !strItemTypeCode & Chr(9) & !最小计量单位 & Chr(9) & !存货计量单位 _
                & Chr(9) & !strPositionCode & Chr(9) & !strAreaCode & Chr(9) & !strCustomerCode _
                & Chr(9) & !strCustomerItemCode & Chr(9) & !dblMinUnitsInStock & Chr(9) & !dblMaxUnitsInStock _
                & Chr(9) & !intLeadTime & Chr(9) & !dblPurchasePrice1 & Chr(9) & !dblPurchasePrice _
                & Chr(9) & !dblSalePrice1 & Chr(9) & !dblSalePrice & Chr(9) & !dblPlanPrice _
                & Chr(9) & !dblRetainPrice & Chr(9) & !intValidDay & Chr(9) & IIf(!blnIsBatch, "1", "0") _
                & Chr(9) & IIf(!blnIsCombination, "1", "0") & Chr(9) & IIf(!blnIsAssembly, "1", "0") _
                & Chr(9) & IIf(!blnIsBorrow, "1", "0") & Chr(9) & !strNotes & Chr(9) & !自定义项目0 _
                & Chr(9) & !自定义项目1 & Chr(9) & !自定义项目2 & Chr(9) & !自定义项目3 _
                & Chr(9) & !自定义项目4 & Chr(9) & !自定义项目5 & Chr(9) & !dblStockQuantity _
                & Chr(13) & Chr(10)
            strSql = "SELECT strUnitName,dblFactor FROM ItemUnit WHERE lngItemID=" & !lngItemID
            Set recUnit = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
            While Not recUnit.EOF
                strTemp = strTemp & recUnit("strUnitName") & "," & recUnit("dblFactor") & " "