listmodule.bas

金算盘软件代码

                recUnit.MoveNext
            Wend
            strTemp = strTemp & Chr(13) & Chr(10)
            recUnit.Close
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
    ExportPartItem StrFileName
End Sub

Private Sub ExportPartItem(ByVal StrFileName 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 = "文件名=PartItem.dat" & Chr(0) & "字段数=5"
    strTemp = strTemp & Chr(0) & "字段1=组件商品编码,1,2"
    strTemp = strTemp & Chr(0) & "字段2=组件商品计量单位ID,2,1"
    strTemp = strTemp & Chr(0) & "字段3=部件商品编码,3,2"
    strTemp = strTemp & Chr(0) & "字段4=部件商品计量单位ID,4,1"
    strTemp = strTemp & Chr(0) & "字段5=部件数量,5,1"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("部件商品", strTemp, StrFileName)
    strSql = "SELECT ItemCombination.*,CI.strItemCode CCode,PI.strItemCode PCode FROM " _
        & "ItemCombination,Item CI,Item PI WHERE " _
        & "ItemCombination.lngCombinationItemID = CI.lngItemID AND " _
        & "ItemCombination.lngPartItemID = PI.lngItemID"
    
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "PartItem.Dat") <> "" Then
            Kill strPath & "PartItem.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "PartItem.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !CCode & Chr(9) & !lngCombinationUnitID & Chr(9) & !PCode _
                & Chr(9) & !lngPartUnitID & Chr(9) & !intQuantity & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportItemUnit(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 = "文件名=ItemUnit.dat" & Chr(0) & "字段数=3"
'    strTemp = strTemp & Chr(0) & "字段1=计量单位ID,1,1"
    strTemp = strTemp & Chr(0) & "字段1=计量单位名称,1,2"
    strTemp = strTemp & Chr(0) & "字段2=商品,2,2"
    strTemp = strTemp & Chr(0) & "字段3=计量规格,3,1"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("商品单位", strTemp, StrFileName)
    strSql = "SELECT *,Item.strItemCode FROM ItemUnit,Item WHERE " _
        & "ItemUnit.lngItemID=Item.lngItemID" & strWhere
'    If Trim(strWhere) = "" Then
'        strSql = strSql & " WHERE ItemUnit.lngUnitID NOT IN (SELECT lngMinUnitID FROM Item)"  '_
''            & " AND ItemUnit.lngUnitID NOT IN (SELECT lngStockUnitID FROM Item)"
'    Else
'        strSql = strSql & " AND ItemUnit.lngUnitID NOT IN (SELECT lngMinUnitID FROM Item)" '_
''            & " AND ItemUnit.lngUnitID NOT IN (SELECT lngStockUnitID FROM Item)"
'    End If
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "ItemUnit.Dat") <> "" Then
            Kill strPath & "ItemUnit.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "ItemUnit.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strUnitName & Chr(9) & !strItemCode _
                & Chr(9) & !dblFactor & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportPosition(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 = "文件名=Position.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,3"
    strTemp = strTemp & Chr(0) & "字段5=编码层次,5,1"
    strTemp = strTemp & Chr(0) & "字段6=末级标志,6,3"
    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 Position.*,Department.strDepartmentCode " _
        & "FROM (Position,Department " _
        & "WHERE Position.lngDepartmentID=Department.lngDepartmentID(+)" _
        & strWhere & " ORDER BY strPositionCode"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "Position.Dat") <> "" Then
            Kill strPath & "Position.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "Position.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strPositionCode & Chr(9) & !strPositionName & Chr(9) & !strFullName _
                & Chr(9) & IIf(!blnIsInActive, "1", "0") & Chr(9) & !intLevel _
                & Chr(9) & IIf(!blnIsDetail, "1", "0") & Chr(9) & !strDepartmentCode _
                & Chr(9) & !strNotes & Chr(9) & !strStartDate & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

Private Sub ExportJobType(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 = "文件名=JobType.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 JobType" & strWhere & " ORDER BY strJobTypeCode"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "JobType.Dat") <> "" Then
            Kill strPath & "JobType.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "JobType.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strJobTypeCode & Chr(9) & !strJobTypeName _
                & Chr(9) & IIf(!blnIsInActive, "1", "0") & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

'导出工程
Private Sub ExportJob(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 = "文件名=Job.dat" & Chr(0) & "字段数=12"
    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,1"
    strTemp = strTemp & Chr(0) & "字段11=备注,11,1"
    strTemp = strTemp & Chr(0) & "字段12=启用日期,12,2"
    strTemp = strTemp & Chr(0) & "导出日期=" & Format(Date, "yyyy-mm-dd")
    lngResult = WritePrivateProfileSection("工程", strTemp, StrFileName)
    strSql = "SELECT Job.*,JobType.strJobTypeCode," & _
        "Customer.strCustomerCode,Employee.strEmployeeCode," & _
        "JobStatus.strJobStatusName from " & _
        "Job,JobType,Customer,Employee,JobStatus WHERE Job.lngJobTypeID=JobType.lngJobTypeID " _
        & "AND Job.lngCustomerID=Customer.lngCustomerID " _
        & "AND Job.lngEmployeeID=Employee.lngEmployeeID(+) " _
        & "AND Job.lngJobStatusID=JobStatus.lngJobStatusID(+)" _
        & strWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    With recTemp
        If Dir(strPath & "Job.Dat") <> "" Then
            Kill strPath & "Job.Dat"
        End If
        intFileNum = FreeFile
        Open strPath & "Job.Dat" For Binary As #intFileNum
        Do While Not .EOF
            strTemp = !strJobCode & Chr(9) & !strJobName _
                & Chr(9) & !strJobTypeCode & Chr(9) & !strCustomerCode _
                & Chr(9) & IIf(!blnIsInActive = True, "1", "0") & Chr(9) & !strEmployeeCode _
                & Chr(9) & !strJobStatusName & Chr(9) & !strBeginDate & Chr(9) & !strEndDate _
                & Chr(9) & !dblPercent & Chr(9) & !strNotes & Chr(9) & !strStartDate _
                & Chr(13) & Chr(10)
            Put #intFileNum, , strTemp
            .MoveNext
        Loop
        Close #intFileNum
    End With
End Sub

'导出凭证
Private Sub ExportVoucher(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 = "文件名=Voucher.dat" & Chr(0) & "字段数=31"
    strTemp = strTemp & Chr(0) & "字段1=期间,1,1"
    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,2"
    strTemp = strTemp & Chr(0) & "字段6=科目代码,6,2"
    strTemp = strTemp & Chr(0) & "字段7=货币代码,7,2"
    strTemp = strTemp & Chr(0) & "字段8=汇率,8,1"
    strTemp = strTemp & Chr(0) & "字段9=原币金额,9,1"
    strTemp = strTemp & Chr(0) & "字段10=借方金额,10,1"
    strTemp = strTemp & Chr(0) & "字段11=贷方金额,11,1"
    strTemp = strTemp & Chr(0) & "字段12=数量,12,1"
    strTemp = strTemp & Chr(0) & "字段13=单价,13,1"
    strTemp = strTemp & Chr(0) & "字段14=制单人,14,2"
    strTemp = strTemp & Chr(0) & "字段15=审核人,15,2"
    strTemp = strTemp & Chr(0) & "字段16=过帐人,16,2"
    strTemp = strTemp & Chr(0) & "字段17=附单据数,17,1"
    strTemp = strTemp & Chr(0) & "字段18=是否已过帐,18,3"
    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,1"
    strTemp = strTemp & Chr(0) & "字段24=统计,24,1"
    strTemp = strTemp & Chr(0) & "字段25=项目,25,1"
    strTemp = strTemp & Chr(0) & "字段26=付款方法,26,1"
    strTemp = strTemp & Chr(0) & "字段27=票据号,27,2"
    strTemp = strTemp & Chr(0) & "字段28=原币付款金额,28,1"