最近接手到一個任務，用excel VBA 編寫一個查詢報表給業(yè)務部門使用，最后使用的方案是使用VBA調用 SAP RFC 來輸出報表。對于VBA 和SAP ABAP我都屬于新手，接到任務也是頭皮發(fā)麻，最終在查閱大量資料后在昨天全部完成。
環(huán)境準備
在環(huán)境準備部分就有一個大坑，vba創(chuàng)建sap.functions、sap.logoncontrol對象時使用的是sap gui目錄下的wdtfuncs.ocx、wdtlog文件，而這些文件是32位的，如果使用64位的excel則訪問不到此文件，會報錯429“不能創(chuàng)建對象”，最后的解決方案，換32位的excel…(巨坑)，在網上看到一個博主也提到了這個問題，留言詢問有沒有別的解決方法后，他給的回復是使用和excel位數一致的.ocx文件是不是就可以了？但我也沒找到有64位的.ocx文件，不知道廣大網友能不能解決這個問題。
在菜單欄 【工具】——【引用】添加上述控件后就完成環(huán)境準備部分。
代碼編寫
新建模塊，編寫代碼：
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"? ? ? ? ? ? ? ? ? ? '系統(tǒng)標識
? ? '? ? .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的創(chuàng)建及代碼部分不做詳細介紹，思路是將要查詢的數據創(chuàng)建結構作為輸出表，在代碼編寫部分主要就是SQL的編寫及數據的整合。
注：RFC 的輸出參數在VBA里是輸入參數，輸入參數在VBA里是輸出參數。在使用Table接受數據時，需要使用到tableFactory控件?？丶?b>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創(chuàng)建一個數組
? ? 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創(chuàng)建數組
? ? 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
