用vba取用友后台的数据。[转帖]

jinhui8012

我不是会计，因工作需要，做了三个函数， 基本上可以搞定 资产负债表 和利润分配表。因为现金流量表我还不会做，所以还没做相关的函数，谁教会我怎么做，我把相关的函数也补齐。 '连接数据库的参数，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

mjf21cn

呵呵，看看，这几天研究这个呢。

naojin

呵呵，一般实施人员或是售前人员都用这方法

tmd2008

不错，学习一下经验！

ht8802

挺好的，学习一下~~

tgut

好东西，先收藏，以后慢慢学习。谢谢楼主

走，暴走

留个联系方式吧.一起讨论下

liuyi159

好东西，先收藏，以后慢慢学习。谢谢楼主

topunion009

不错，学习一下经验！