'補寫貸方
                            entryD("FDC") = 0
                            entryD("FAmount") = iFSupplyAmtSum     '寫貸方金額 ，等于補領金額
                        ElseIf iFRefundAmtsum > 0 Then
                            entryD("FDC") = 1                '補寫借方
                            entryD("FAmount") = iFRefundAmtsum     '寫貸方金額 ，等于退還金額
                        End If
                    End If
                    entryD("FQuantity") = 0
                    entryD("FUnitPrice") = 0
                    entryD("FMeasureUnitID") = 0
                    
                    Set mvchdetail = New KFO.Vector
                    bret = getAccItem(CLng(sVouType(1)), sAccItem)
                    '創建核算項目明細
                    If sAccItem(1) <> "" Then
                        Set detail = New KFO.Dictionary
                        detail("FItemClassNumber") = sAccItem(1)
                        If sAccItem(1) = "002" Then detail("FItemNumber") = sDepId
                        If sAccItem(1) = "003" Then detail("FItemNumber") = sProposer
                        mvchdetail.Add detail
                    End If
                    If sAccItem(2) <> "" Then
                        Set detail = New KFO.Dictionary
                        detail("FItemClassNumber") = sAccItem(2)
                        If sAccItem(2) = "002" Then detail("FItemNumber") = sDepId
                        If sAccItem(2) = "003" Then detail("FItemNumber") = sProposer
                        mvchdetail.Add detail
                    End If
                    Set entryD("_Details") = mvchdetail
                    
                    If entryD("FDC") = 0 Then
                        tmpmvchentryD.Add entryD
                    ElseIf entryD("FDC") = 1 Then
                        tmpmvchentry.Add entryD
                    End If
                End If
                
                '拼生憑證正確的單據內碼
                If tmpmvchentry.Size > 0 Or tmpmvchentryD.Size > 0 Then
                    For j = 1 To tmpmvchentry.Size
                        mvchentry.Add tmpmvchentry.Item(j)
                    Next j
                    
                    For j = 1 To tmpmvchentryD.Size
                        mvchentry.Add tmpmvchentryD.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)
        '彈出憑證界面修改憑證
        Dim Vch As Object, Mode As Long
        Set Vch = CreateObject("Mvedit.MVoucherEdit")
        Mode = 2
        Vch.LoadVoucher Mode, VouInfo
        Set Vch = Nothing
        '取憑證信息
        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
        '更新單據中的憑證號
        s = "Update t_EP_ER_WipeOff1 set FVouID=" & VouInfo & ", FVouUser=" & m_ListInterface.K3Lib.User.UserID & ",FVouInfo= '" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber) & "' where fid in (" & sfid & ")"

         m_ListInterface.K3Lib.UpdateData s
         If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    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

'-----------------------------------------------------
'根據科目查找對應的核算項目，最多處理兩個，且是002（部門） 和003（職員）
'-----------------------------------------------------
Private Function getAccItem(AccID As Long, ByRef sRet() As String) As Boolean
    Dim tmpRs1 As New ADODB.Recordset
    Dim iCun As Integer
    Dim j As Integer
    '根據科目查找對應的核算項目
    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 (t3.fnumber=002 or t3.fnumber=003)" & _
            " and t2.FAccountid='" & AccID & "'"
    Set tmpRs1 = m_ListInterface.K3Lib.GetData(sSql)
    ReDim sRet(1 To 2)
    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(j) = tmpRs1!FNumber
            tmpRs1.MoveNext
        Next j
    End If
    
    Set tmpRs1 = Nothing
End Function

'***********************************************************************************
'導入憑證
'參數 VouVector 用戶選擇的報銷單據信息
'
'***********************************************************************************
Private Function ImportWipeVou(VouVector As KFO.Vector) As Boolean
    Dim glVouRs As New KFO.Vector
    Dim lFid As Long                            '單據編號
    Dim glvch As Object                         '中間層憑證對象
    Dim mvch As KFO.Dictionary                  '待保存憑證頭
    Dim mvchentry As KFO.Vector                 '待保存憑證分錄集
    Dim entry As KFO.Dictionary                 '待保存憑證分錄
    Dim mvchdetail As KFO.Vector                '核算項目明細集
    Dim detail As KFO.Dictionary                '核算項目明細
    Dim i, iCount As Long, j As Long, k As Long
    Dim vValue      As Variant
    Dim rs As New ADODB.Recordset
    
    Dim sVouType() As String  '憑證模板數組
    
    Dim sDepId As String         '部門編碼
    Dim sProposer As String      '申請人編碼
    Dim lWipeItem As Long       '報銷項目
    Dim lLoanType As Long       '借款方式
    Dim sBillNo As String       '單據編碼
    Dim cWipeAmt As Currency    '報銷金額
    Dim cLoanamt As Currency    '借款金額
    Dim lfidSRC As Long         '源單內碼
    Dim iVouTplType As Integer  '憑證模板類型
    Dim iWipeType As Integer    '支出方式
    
    Dim sSql As String
    Dim sInfo As String          '最后提示信息
    Dim sfid As String          '要更新單據內碼集
    Dim tmpmvchentry As KFO.Vector '臨時保存一張單據中的分錄集
    Dim bret As Boolean
    Dim sErr As String
    Dim tmpRs As New ADODB.Recordset

    On Error GoTo ERR
    sInfo = ""
   

    '此處添加處理 生成憑頭
    Set mvch = New KFO.Dictionary
    '日期取當前會計期間
    Dim sYear As String
    Dim sPeriod As String
    sYear = m_ListInterface.K3Lib.GetData("select FValue from t_systemprofile where FCategory='GL' and FKey='CurrentYear'")("FValue")
    sPeriod = m_ListInterface.K3Lib.GetData("select FValue from t_systemprofile where FCategory='GL' and FKey='CurrentPeriod'")("FValue")
    mvch("FDate") = getDate(sYear, sPeriod)
'    mvch("FDate") = m_ListInterface.K3Lib.GetData("SELECT GETDATE() AS FDate")("Fdate")
    mvch("FGroupID") = "1"
'    mvch("FReference") =

    '初始化憑證分錄集********************************
    Set mvchentry = New KFO.Vector
    '***********************************************
    With VouVector
    i = 1
begFor: While i <= VouVector.Size
            '取單據編號
            lFid = .Item(i)("Fid")
            
            
            '判斷是否生成過憑證, '判斷是否已經審核
            sSql = "select FVouUser,FVouid,FBillno,FUser from t_EP_ER_WipeOff1 t1 where t1.Fid='" & lFid & "'"
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            If rs.State = adStateOpen And rs.RecordCount > 0 Then
                sInfo = sInfo & "支出憑單：" & rs("FBillno") & "生成憑證"
                If Not (CStr(rs("FVouUser")) = "" Or CLng(rs("FVouUser") = 0)) <> 0 Then
                    sSql = "select isnull(count(*),0)  as vouCun from t_voucher where fvoucherid= '" & rs!FVouid & "'"
                    Set tmpRs = m_ListInterface.K3Lib.GetData(sSql)
                    If tmpRs!vouCun <> 0 Then
                        i = i + 1
                        sInfo = sInfo & "失敗！原因: 已經生成憑證。" & vbCrLf
                        GoTo begFor
                    End If
                    If rs.State = adStateOpen Then tmpRs.Close
                End If
                If CLng(rs("FUser")) = 0 Then
                     i = i + 1
                     sInfo = sInfo & "失敗！原因: 單據還沒有審核。" & vbCrLf
                     GoTo begFor
                End If

            End If
            If rs.State = adStateOpen Then rs.Close

            '取單據信息
            sSql = "select  t2.Fnumber as DepNum,t3.Fnumber as ProposerNum,* from t_EP_ER_WipeOff1Entry1  t1" & _
                    " Inner join t_EP_ER_WipeOff1 t11 on t1.fid=t11.fid " & _
                    " left join t_item t2 on t2.Fitemclassid=2 and  t1.FDivideDep =t2.Fitemid " & _
                    " left join t_item t3 on t3.Fitemclassid=3 and  t11.FProposer =t3.Fitemid " & _
                    " where t1.Fid='" & lFid & "'"
                    
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            '單據存在繼續
            If rs.State = adStateOpen And rs.RecordCount > 0 Then
                '初始化一張單據的憑證分錄集********************************
                Set tmpmvchentry = New KFO.Vector
                '**********************************************************
                
                k = 1
begwhile:      While k <= rs.RecordCount
        
                    '部門 ,申請人，報銷項目，借款方式，單據編號，報銷金額，借款金額,源單內碼 ,
                    sDepId = rs("DepNum")
                    sProposer = rs("ProposerNum")
                    lWipeItem = rs("FWipeItem")
                    lLoanType = rs("FLoanType")
                    sBillNo = rs("FBillno")
                    cWipeAmt = rs("FWipeAmt")
                    cLoanamt = rs("FLoanAmt")
                    lfidSRC = rs("FID_SRC")
                    iWipeType = rs("FWipeType")  '支出方式
                    
                    '判斷報銷單的類型
'                        1有借款單，且是現金'
'                        2有借款單，且是銀行存款'
'                        3沒有借款單，直接借款報銷'

                    If lfidSRC <> 0 And lLoanType = "1000201" Then
                        iVouTplType = 1
                    ElseIf lfidSRC <> 0 And lLoanType <> "1000201" Then
                        iVouTplType = 2
                    ElseIf lfidSRC = 0 Then
                        iVouTplType = 3

                    Else
                        k = k + 1
                        sInfo = sInfo & "支出憑單：" & rs("FBillno") & "中的第" & k & "第分錄，不能生成憑證！原因：報銷單不在3種報銷類型中" & vbCrLf
                        GoTo begwhile
                    End If


                    '取憑證分錄模板
                    bret = getVouEntryInfo(rs("FDivideDep"), lWipeItem, iVouTplType, sVouType())
                    If bret = False Then
                        k = k + 1
                        sInfo = sInfo & "支出憑單：" & rs("FBillno") & "中的第" & k & "第分錄，不能生成憑證！原因：沒有對應的憑證模板" & vbCrLf
                        GoTo begwhile
                       Exit Function
                    End If
                    
 '                   4有借款單，其預借的金額不夠。'
'                    5有借款單，且有剩于金額"
                     If lfidSRC <> 0 And cWipeAmt > cLoanamt Then
                        iVouTplType = 4
                    ElseIf lfidSRC <> 0 And cWipeAmt < cLoanamt Then
                        iVouTplType = 5
                    End If
                    '創建憑證分錄
                    Set entry = New KFO.Dictionary
                    
                    For j = 1 To UBound(sVouType, 2)
                    
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "支出憑單，單據編號：" & sBillNo
                        entry("FAccountID") = sVouType(3, j)
                        entry("FDC") = sVouType(2, j)
                        '4有借款單，其預借的金額不夠
                        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