用vba取用友后台的数据。[原创]

rida

我不是会计，因工作需要，做了三个函数， 基本上可以搞定 资产负债表 和利润分配表。
因为现金流量表我还不会做，所以还没做相关的函数，谁教会我怎么做，我把相关的函数也补齐。

'连接数据库的参数，driver 连sql server的常数不用改 其中 server为数据库所在服务器的机器名或IP地址
'uid为sql server的帐号名称, pwd为相应帐号的密码

Const connstr = "driver={SQL Server}; server=202.0.0.2;uid=sa;pwd=123pwd321"
Dim conn As ADODB.Connection
Dim rst, rs As ADODB.Recordset
Dim NewBook As Workbook

'
'这是一段测试代码，可以取科目表
'
Sub getdatatest()
    Dim i As Integer
    Set conn = New ADODB.Connection

With conn
     .ConnectionString = connstr & ";database=UFDATA_003_2003"
     .Open strConn
End With

Set rst = New ADODB.Recordset

With rst
   .ActiveConnection = conn
   .Open "SELECT A.ccode, B.ccode_name AS code_name, A.iperiod, A.mb, A.md, A.mc, A.me " & _
          " FROM GL_accsum A INNER JOIN " & _
               " code B ON A.ccode = B.ccode "
End With

Set NewBook = Workbooks.Add

    For i = 0 To rst.Fields.Count - 1
        NewBook.Sheets(1).Range("a1").Offset(0, i).Value = rst.Fields(i).Name
    Next i
    NewBook.Sheets(1).Range("a2").CopyFromRecordset rst
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Sub

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

'
'取科目的期末值
'参数cCode:科目代码, TimeValue :时间值,如1月，2月等, YearName可选 默认为系统的年份, Account可选 帐套号 默认为 "003"
'

Function qm(cCode, TimeValue, Optional YearName As String, Optional Account As String = "003")
    Dim csqlstr As String
    qm = 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.me ELSE - a.me 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
    qm = rst.Fields(0).Value
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Function

'
'取科目的期初值
'参数cCode:科目代码,TimeValue :时间值,如1月，2月等, YearName可选 默认为系统的年份
'TimeType时间类别 分为 年和月默认为月,Account可选 帐套号 默认为 "003"
'
Function qc(cCode, TimeValue, Optional YearName As String, Optional TimeType As String = "月", Optional Account As String = "003")
    Dim csqlstr As String
    qc = 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.mb ELSE -gl_accsum.mb 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
    qc = rst.Fields(0).Value
    Set rst = Nothing
    conn.Close
    Set conn = Nothing

End Function

'
'取科目的发生数
'参数cCode:科目代码,TimeValue :时间值,如1月，2月等, Direction 为借 代 方向,YearName可选 默认为系统的年份
'ifcheck 是否记帐 默认为0没记帐,Account可选 帐套号 默认为 "003"
'
Function fs(cCode, TimeValue, Direction, Optional TimeType As String = "月", Optional YearName As String, Optional ifcheck As Integer = 0, Optional Account As String = "003")

   Dim csqlstr As String
   fs = 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.md ELSE a.mc 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
   fs = 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

xd3210

收下来学习一下，谢谢

EdgeOfCity

请问同行们，常用的财务软件(如用友/金蝶/浪潮/等)的后台数据库都是什么？
我以前只用过一个行业软件。数据库为Sql server.

EdgeOfCity

虽然没用过用友，但是楼主这个帖显然应该顶一下。需要的朋友可能不少。

luyulei

谢谢！能把你做好的EXCEL表格上传么？

徒然客

以下是引用EdgeOfCity在2003-12-22 17:47:00的发言：
请问同行们，常用的财务软件(如用友/金蝶/浪潮/等)的后台数据库都是什么？
我以前只用过一个行业软件。数据库为Sql server.

用过教学版的金蝶，后台是Access
用友有两种一种是SQL版的，一种是Access的。现在大都用SQL的了。

luyulei

在EXCEL中为何提示“用户定义类型未定义”（conn As ADODB.Connection）？

luyulei

呵呵！我试了一下，挺好用的！正在学习。我觉得F417和F2所用的方法应该和rida兄的基本一样吧。谢谢！希望能再改进一下，支持部门和项目。

rida

谢谢大家的关注，其实我想到这里学点财务分析的知识。我不是做会计的，希望大家多多指教。luyulei 兄我会考虑改进的。

EdgeOfCity

谢谢楼主提供的代码。
也谢谢楼上各位对我问题的答复。