求助，用友取数不能正确取非末级科目数量

207758

在论坛里找到取用友数据的函数，想修改一下取数量，取发生额数量不管末级非末级都能正常取值，但期初、期末函数只能正确取末级科目，取的非末级科目数量只要与末级科目年初数量相加，结果才是正确的。      
那位高手能帮帮小弟。

'连接数据库的参数，driver 连sql server的常数不用改 其中 server为数据库所在服务器的机器名或IP地址
'uid为sql server的帐号名称, pwd为相应帐号的密码
Const connstr = "driver={SQL Server}; server=Cw;uid=sa;pwd="
Dim conn As ADODB.Connection
Dim rst, rs As ADODB.Recordset
Dim NewBook As Workbook
'

'sql语句中字符变量加引号的函数
'
Function SqlStr(data)
  
   SqlStr = "'" & Replace(data, "'", "''") & "'"
  
End Function


'取科目的期末值数量
'参数cCode:科目代码, TimeValue :时间值,如1月，2月等, YearName可选 默认为系统的年份, Account可选 帐套号 默认为 "001"
'
Function Slqm(cCode, TimeValue, Optional YearName As String, Optional Account As String = "001")
    Dim csqlstr As String
    Slqm = 0
    If Trim(cCode) = "" Then Exit Function
    If Trim(TimeValue) = "" Then Exit Function
    If Trim(Account) = "" Then Exit Function
    If Trim(YearName) = "" Then YearName = Format(Now(), "yyyy")
    Set conn = New ADODB.Connection
    With conn
         .ConnectionString = connstr & ";database=UFDATA" & "_" & Trim(Account) & "_" & Trim(YearName)
         .Open strConn
    End With
   
    csqlstr = "SELECT SUM((CASE WHEN a.cendd_c <> '贷' THEN a.ne_s ELSE - a.ne_s END))" & _
                        " AS SumVal " & _
               " FROM code b INNER JOIN " & _
               " gl_accsum a ON b.ccode = a.ccode " & _
               " WHERE a.iperiod = " & TimeValue & " AND a.ccode = " & SqlStr(cCode)
   
    Set rst = New ADODB.Recordset
    With rst
         .ActiveConnection = conn
         .Open csqlstr
    End With
    Slqm = rst.Fields(0).Value
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Function

'取科目的期初值数量
'参数cCode:科目代码,TimeValue :时间值,如1月，2月等, YearName可选 默认为系统的年份
'TimeType时间类别 分为 年和月默认为月,Account可选 帐套号 默认为 "001"
'
Function Slqc(cCode, TimeValue, Optional YearName As String, Optional TimeType As String = "月", Optional Account As String = "001")
    Dim csqlstr As String
    Slqc = 0
    If Trim(cCode) = "" Then Exit Function
    If Trim(Account) = "" Then Exit Function
    If Trim(YearName) = "" Then YearName = Format(Now(), "yyyy")
    If Trim(TimeValue) = "" Then Exit Function
   
    If Trim(TimeType) = "年" Then TimeValue = 1
   
    Set conn = New ADODB.Connection
    With conn
         .ConnectionString = connstr & ";database=UFDATA" & "_" & Trim(Account) & "_" & Trim(YearName)
         .Open strConn
    End With
   
    csqlstr = "SELECT sum((CASE WHEN gl_accsum.cbegind_c<>'贷' THEN gl_accsum.nb_s ELSE -gl_accsum.nb_s End))" & _
                        " AS SumVal " & _
               " FROM code INNER JOIN gl_accsum ON code.ccode = gl_accsum.ccode " & _
               " WHERE gl_accsum.iperiod = " & TimeValue & " AND gl_accsum.ccode = " & SqlStr(cCode)
   
    Set rst = New ADODB.Recordset
    With rst
         .ActiveConnection = conn
         .Open csqlstr
    End With
    Slqc = rst.Fields(0).Value
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Function


'取科目的发生数数量
'参数cCode:科目代码,TimeValue :时间值,如1月，2月等, Direction 为借 代 方向,YearName可选 默认为系统的年份，TimeType时间类别 分为 年和月默认为月
'ifcheck 是否记帐 默认为0没记帐,Account可选 帐套号 默认为 "001"
'
Function Slfs(cCode, TimeValue, Direction, Optional TimeType As String = "月", Optional YearName As String, Optional ifcheck As Integer = 0, Optional Account As String = "001")
   Dim csqlstr As String
   Slfs = 0
   If Trim(cCode) = "" Then Exit Function
   If Trim(TimeType) = "" Then Exit Function
   If Trim(TimeValue) = "" Then Exit Function
   If Trim(Direction) = "" Then Exit Function
   If Trim(Account) = "" Then Exit Function
   If Trim(YearName) = "" Then YearName = Format(Now(), "yyyy")
   If Trim(ifcheck) = "" Then Exit Function
   Set conn = New ADODB.Connection
    With conn
         .ConnectionString = connstr & ";database=UFDATA" & "_" & Trim(Account) & "_" & Trim(YearName)
         .Open strConn
    End With
   
   csqlstr = " SELECT sum((CASE when "
   If Direction = "借" Then
          csqlstr = csqlstr & " 1=1 "
   Else
          csqlstr = csqlstr & " 1=0 "
   End If
   csqlstr = csqlstr & " THEN a.nd_s ELSE a.nc_s End)) as SumVal FROM code b INNER JOIN gl_accvouch a ON b.ccode = a.ccode "
   If TimeType = "年" Then
         csqlstr = csqlstr & " where a.iperiod>=1 and a.iperiod<=" & TimeValue
      Else
         csqlstr = csqlstr & " where a.iperiod=" & TimeValue
   End If
   csqlstr = csqlstr & " AND a.iflag is null AND a.ccode "
   If ifbend(conn, cCode) = 1 Then
      csqlstr = csqlstr & "=" & SqlStr(cCode)
   Else
      csqlstr = csqlstr & "like " & SqlStr(cCode & "%")
   End If
   If ifcheck = 1 Then
     csqlstr = csqlstr & " AND a.ibook=" & ifcheck
   End If
   
   Set rst = New ADODB.Recordset
   With rst
         .ActiveConnection = conn
         .Open csqlstr
   End With
   Slfs = rst.Fields(0).Value
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Function
'
这个是判断科目是否为末级的函数
'
Function ifbend(conn, cCode)
   Dim strsql As String
   strsql = " select bend from code where ccode=" & SqlStr(cCode)
   Set rs = New ADODB.Recordset
   With rs
       .ActiveConnection = conn
       .Open strsql
   End With
   ifbend = rs.Fields(0).Value
   Set rs = Nothing
End Function

cJqQhr5O.rar (10.85 KB, 下载次数: 16)

2006-5-11 15:02 上传

点击文件名下载附件
求助，用友取数不能正确取非末级科目数量

[此贴子已经被作者于2006-5-11 15:10:35编辑过]