最近接手到一个任务，用excel VBA 编写一个查询报表给业务部门使用，最后使用的方案是使用VBA调用 SAP RFC 来输出报表。对于VBA 和SAP ABAP我都属于新手，接到任务也是头皮发麻，最终在查阅大量资料后在昨天全部完成。
环境准备
在环境准备部分就有一个大坑，vba创建sap.functions、sap.logoncontrol对象时使用的是sap gui目录下的wdtfuncs.ocx、wdtlog文件，而这些文件是32位的，如果使用64位的excel则访问不到此文件，会报错429“不能创建对象”，最后的解决方案，换32位的excel…(巨坑)，在网上看到一个博主也提到了这个问题，留言询问有没有别的解决方法后，他给的回复是使用和excel位数一致的.ocx文件是不是就可以了？但我也没找到有64位的.ocx文件，不知道广大网友能不能解决这个问题。
在菜单栏 【工具】——【引用】添加上述控件后就完成环境准备部分。
代码编写
新建模块，编写代码：
Option Explicit
Dim sapLongonControl As SAPLogonCtrl.SAPLogonControl
Dim sapConnection As SAPLogonCtrl.Connection
Public Sub Logon()
Set sapLongonControl = CreateObject("SAP.LogonControl.1")
Set sapConnection = sapLongonControl.NewConnection
With sapConnection
' .System = "ED1" '系统标识
' .ApplicationServer = "100.100.190.210" '应用服务器
.SAPRouter = "/H/61.155.85.163/H/" '外网连接的SAP路由
.SystemNumber = "00" '实例编号
.Client = "600" '客户端
.User = "****" '用户名
.Password = "****" '密码
.CodePage = "8400" '解决中文乱码问题
End With
Call sapConnection.Logon(0, True) ' hWnd, Silent Logon '此处如果括号里是False则会跳出登陆窗口，True则不跳登陆窗口直接登陆
If sapConnection.IsConnected = tloRfcConnected Then
' MsgBox "OK"
Else
MsgBox "Error code:" & sapConnection.IsConnected
End If
End Sub
Public Sub Logoff()
If sapConnection.IsConnected = tloRfcConnected Then
sapConnection.Logoff
End If
End Sub
RFC部分
在RFC部分使用的Tbale参数作为输出参数传到VBA，查询条件作为输入参数。RFC的创建及代码部分不做详细介绍，思路是将要查询的数据创建结构作为输出表，在代码编写部分主要就是SQL的编写及数据的整合。
注：RFC 的输出参数在VBA里是输入参数，输入参数在VBA里是输出参数。在使用Table接受数据时，需要使用到tableFactory控件。控件为wdtaocx.ocx，Windows 7下默认的路为： C:\Program Files (x86)\SAP\FrontEnd\SAPgui。
VBA代码部分
Private Sub GetData()
Dim functions As SAPFunctionsOCX.SAPFunctions
Dim fm As SAPFunctionsOCX.Function
Dim cocdDetail As SAPTableFactoryCtrl.Table
Set functions = New SAPFunctions
Set functions.Connection = sapConnection
' FM加入Functions集合
Set fm = functions.Add("RFC函数名")
'填充参数，RFC的输入参数对VBA来说是输出参数
fm.Exports("SPART_IN").Value = ***
'调用
fm.Call
'得到Table参数
Set cocdDetail = fm.Tables("ITAB_OUT")
Call WriteTable(cocdDetail, Sheet2) '输出结果，此处cocdDetail是一个二维表，所以时候遍历的方式取得表数据。为了更具一般性，编写一个通用的routine,将表输出到excel。
End Sub
Public Sub WriteTable(itab As SAPTableFactoryCtrl.Table, sht As Worksheet)
Dim col As Long ' column index
Dim row As Long ' row index Dim headerRange As Variant '在Excel中根据itab的header大小，类型为Variant数组
Dim itemsRange As Variant '在Excel中根据itab的行数和列数，类型为Variant数组
If itab.RowCount = 0 Then Exit Sub
'-------------------------------------------------
' 取消Excel的屏幕刷新和计算功能以加快速度
'-------------------------------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' 清除cells的内容
sht.Cells.ClearContents
'------------------------------
' 将Table的Header写入Worksheet
'------------------------------
' 根据内表的列数，使用Range创建一个数组
Dim headerstarts As Range
Dim headerends As Range
Set headerstarts = sht.Cells(1, 1)
Set headerends = sht.Cells(1, itab.ColumnCount)
headerRange = sht.Range(headerstarts, headerends).Value
' 将内表列名写入数组
For col = 1 To itab.ColumnCount
headerRange(1, col) = itab.Columns(col).Name
Next
' 从数组一次性写入Excel，这样效率较高
sht.Range(headerstarts, headerends).Value = headerRange
'-------------------------------
' 将Table的行项目写入Worksheet
'-------------------------------
' 根据内表的大小,使用Range创建数组
Dim itemStarts As Range
Dim itemEnds As Range
Set itemStarts = sht.Cells(2, 1)
Set itemEnds = sht.Cells(itab.RowCount + 1, itab.ColumnCount)
itemsRange = itab.Data
' 一次性将数组写入Worksheet
sht.Range(itemStarts, itemEnds).Value = itemsRange
'---------------------------------
' 恢复Excel的屏幕刷新和计算
'---------------------------------
Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomaticEnd Sub
网友评论