bos_wipelist_plugins.cls

完成报销系统的业务流程；在报销系统中达到预算控制目的；将历史数据导入金蝶账套生成历史备查数据。

                    
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "报销单，单据编号：" & sBillNo
                        entry("FAccountID") = sVouType(3, j)
                        entry("FDC") = sVouType(2, j)
                        '有借款单，其预借的金额不够 贷方多加一个现金分录
                        If iVouTplType = 4 And sVouType(2, j) = 0 Then
                            entry("FAmount") = cLoanamt
                        ElseIf iVouTplType = 4 And sVouType(2, j) = 1 Then
                            entry("FAmount") = cWipeAmt
                        
                        '5有借款单，且有剩于金额" 借方多加一个现金分录
                        ElseIf iVouTplType = 5 And sVouType(2, j) = 1 Then
                            entry("FAmount") = cWipeAmt
                        ElseIf iVouTplType = 5 And sVouType(2, j) = 0 Then
                            entry("FAmount") = cLoanamt
                        Else
                            entry("FAmount") = cWipeAmt
                        End If
                        entry("FQuantity") = 0
                        entry("FUnitPrice") = 0
                        entry("FMeasureUnitID") = 0
                        
                        Set mvchdetail = New KFO.Vector
                        '创建核算项目明细
                        If sVouType(4, j) <> "" Then
                            
                            Set detail = New KFO.Dictionary
                            detail("FItemClassNumber") = sVouType(4, j)
                            If sVouType(4, j) = "002" Then detail("FItemNumber") = sDepId
                            If sVouType(4, j) = "003" Then detail("FItemNumber") = sProposer
                            mvchdetail.Add detail
                        End If
                        If sVouType(5, j) <> "" Then
'                            Set mvchdetail = New KFO.Vector
                            Set detail = New KFO.Dictionary
                            detail("FItemClassNumber") = sVouType(5, j)
                            If sVouType(5, j) = "002" Then detail("FItemNumber") = sDepId
                            If sVouType(5, j) = "003" Then detail("FItemNumber") = sProposer
                            mvchdetail.Add detail
                            
                        End If
                       Set entry("_Details") = mvchdetail
                       tmpmvchentry.Add entry
'                        mvchentry.Add entry
      
                    Next j
                     '有借款单，其预借的金额不够 贷方多加一个现金分录
                     If iVouTplType = 4 Then
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "报销单，单据编号：" & sBillNo
                        entry("FAccountID") = "1000"
                        entry("FDC") = 0
                        entry("FAmount") = cWipeAmt - cLoanamt
                        entry("FQuantity") = 0
                        entry("FUnitPrice") = 0
                        entry("FMeasureUnitID") = 0
                        Set mvchdetail = New KFO.Vector
                        Set entry("_Details") = mvchdetail
                       tmpmvchentry.Add entry
'                        mvchentry.Add entry
                    End If
                    '5有借款单，且有剩于金额" 借方多加一个现金分录
                    If iVouTplType = 5 Then
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "报销单，单据编号：" & sBillNo
                        entry("FAccountID") = 1000
                        entry("FDC") = 1
                        entry("FAmount") = cLoanamt - cWipeAmt
                        entry("FQuantity") = 0
                        entry("FUnitPrice") = 0
                        entry("FMeasureUnitID") = 0
                        Set mvchdetail = New KFO.Vector
                        Set entry("_Details") = mvchdetail
                       tmpmvchentry.Add entry
'                        mvchentry.Add entry
                    End If
                    
                     k = k + 1
                     rs.MoveNext
                Wend
                '拼生凭证正确的单据内码
                If tmpmvchentry.Size > 0 Then
                    For j = 1 To tmpmvchentry.Size
                        mvchentry.Add tmpmvchentry.Item(j)
                    Next j
            
                   If sfid = "" Then
                       sfid = sfid & CStr(lFid)
                   Else
                       sfid = sfid & "," & CStr(lFid)
                   End If
                   sInfo = sInfo & "报销单：" & sBillNo & "生成凭证成功！" & vbCrLf
                Else
                    sInfo = sInfo & "报销单：" & sBillNo & "生成凭证失败！原因如上" & ERR.Description & vbCrLf
             
                End If
            End If
            If rs.State = adStateOpen Then rs.Close
            i = i + 1
         Wend
         
        Set mvch("_Entries") = mvchentry
    End With
    Dim s As String

    '如果凭证分录集不为空，则提交中间层组件生成凭证
    Dim VouInfo
    If mvch("_Entries").Size <> 0 Then
 'modify by christin 20060807
        s = GetConnectionProperty("PropsString")
'        s = MMTS.PropsString
'        s = "ConnectString={Provider=SQLOLEDB.1;User ID=sa;Password=;Data Source=KINGDEEKFB;Initial Catalog=AIS20051221092013};UserName=administrator;UserID=16394;DBMS Name=Microsoft SQL Server;DBMS Version=2000;SubID=k3bos;AcctType=gy;Setuptype=Industry;Language=chs;IP=127.0.0.1;MachineName=KINGDEEKFB;UUID=68C61112-D052-4DFC-B43B-DD3028222ACB"
        Set glvch = m_ListInterface.K3Lib.CreateK3Object("EBSGLVoucher.VoucherUpdate")
        VouInfo = glvch.Create(s, mvch)
        '更新单据中的凭证号
        s = "Update t_BOSWipeoff set FVouID=" & VouInfo & ", FVouUser=" & m_ListInterface.K3Lib.User.UserID & " where fid in (" & sfid & ")"

         m_ListInterface.K3Lib.UpdateData s

        '取凭证信息
        sSql = "select t1.*,t2.FName as GroupName from t_voucher  t1 " & _
                            "left join t_Vouchergroup  t2 on t1.FGroupID= t2.FGroupid where FvoucherID=" & VouInfo

        Set rs = m_ListInterface.K3Lib.GetData(sSql)

        If rs.State = adStateOpen And rs.RecordCount = 1 Then

            sInfo = sInfo & "凭证信息－会计期间：" & CStr(rs!FYear) & "." & CStr(rs!FPeriod) & ",凭证字号:" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber)
'            ImportLog12 sInfo
        End If
    End If
    
    MsgBox "凭证生成完成！" & vbCrLf & sInfo, vbInformation + vbOKOnly, "金蝶提示"
    ImportLoanVou = True
    Exit Function
ERR:
    Set glVouRs = Nothing
    Set glvch = Nothing
    Set mvch = Nothing
    Set mvchentry = Nothing
    Set entry = Nothing
    Set mvchdetail = Nothing
    Set detail = Nothing
    MsgBox ERR.Number & "-" & ERR.Description, vbOKOnly + vbExclamation, HINTINFO
End Function
'***********************************************************************************
'取凭证模板的分录信息
'lDep           部门
'lWipeItem      报销项目
'iVouTplType    凭证模板类型
'参数 sRet      分录内容
'借款方式  1000201 现金 1000202 支票
'***********************************************************************************
Private Function getVouEntryInfo(lDep As Long, lWipeItem As Long, iVouTplType As Integer, ByRef sRet() As String) As Boolean

    Dim sSql As String
    Dim i As Integer, j As Integer
    Dim tmpRs As New ADODB.Recordset
    Dim tmpRs1 As New ADODB.Recordset
    Dim iCun As Integer
    sSql = "select * from t_EP_ER_VouTypeEntry where FVouTempletType=2  and FDepid= '" & lDep & "' and FWipeItem= '" & lWipeItem & "'" & _
            " and FVouType='" & iVouTplType & "' order by  FVouFdc DESC "
    On Error GoTo ERR

    Set tmpRs = m_ListInterface.K3Lib.GetData(sSql)
    If tmpRs.State = adStateOpen And tmpRs.EOF Then
        getVouEntryInfo = False
        Exit Function
    End If
    ReDim sRet(1 To 5, 1 To tmpRs.RecordCount)
    i = 1
    tmpRs.MoveFirst
    While Not tmpRs.EOF
        sRet(1, i) = iVouTplType ' 凭证模板类型
        sRet(2, i) = tmpRs!FVouFdc   '借贷方向
        sRet(3, i) = tmpRs!FAccID   '科目ID
        '根据科目查找对应的核算项目
        sSql = "select t3.FNumber from t_itemdetailv t1 ,t_account t2,t_itemclass t3 " & _
                "where t1.FDetailid=t2.FDetailID and t1.FItemid=-1  and  t1.fitemclassid= t3.fitemclassid " & _
                " and t2.FAccountid='" & tmpRs!FAccID & "'"
        Set tmpRs1 = m_ListInterface.K3Lib.GetData(sSql)
            If tmpRs1.State = adStateOpen And tmpRs1.RecordCount > 0 Then
                If tmpRs1.RecordCount > 2 Then
                    iCun = 2
                Else
                    iCun = tmpRs1.RecordCount
                End If
                For j = 1 To iCun '只取两个核算项目
                    sRet(3 + j, i) = tmpRs1!FNumber
                    tmpRs1.MoveNext
                Next j
            End If

 
        i = i + 1
        tmpRs.MoveNext
    Wend
    

    getVouEntryInfo = True
    Set tmpRs = Nothing
    Set tmpRs1 = Nothing
    Exit Function
ERR:
    Set tmpRs = Nothing
    Set tmpRs1 = Nothing
    getVouEntryInfo = False

End Function