エクセルからSAPデータの取得する方法
SAPのデータを取得するにはRFC(Remote Function Call)と呼ばれる汎用モジュールがを使用し、Excelマクロを使って取得することが可能です。
RFCに対応したBAPIは、ABAP以外の外部システムから呼び出すことが可能です。
使用する汎用モジュールは「RFC_READ_TABLE」です。
サンプルソースコード
品目マスタMARAより取得しExcelに出力するサンプルです。
実行するとExcel上に新しいシートが作成されて、
項目名に続いてデータの内容が2行目以降にエクセル上に表示されます。
取得に必要なテーブル項目名を変更することで、
エクセルよりSAPのデータを取得することが可能です。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 |
Sub SEL_MARA() Sheets.Add After:=ActiveSheet Dim functionctrl As Object Dim sapConnection As Object Dim Result As Boolean Dim iRow, iColumn, iStart, iStartRow, iField, iLength As Integer Dim vField As String Dim RFC As Object Dim I_QUERY_TABLE As Object Dim I_DELIMITER As Object Dim I_NODATA As Object Dim I_ROWSKIPS As Object Dim I_ROWCOUNT As Object Dim IT_OPTIONS As Object Dim IT_FIELDS As Object Dim IT_DATA As Object ' SAPコンポーネント Set functionctrl = CreateObject("SAP.Functions") ' R/3接続 Set sapConnection = functionctrl.Connection ' ログイン実行 If sapConnection.Logon(0, False) <> True Then MsgBox "ログイン失敗", vbCritical Application.Cursor = xlDefault Set functionctrl = Nothing Set sapConnection = Nothing Exit Sub End If On Error GoTo MyError 'BAPI定義 Set RFC = functionctrl.Add("RFC_READ_TABLE") ' importパラメータ Set I_QUERY_TABLE = RFC.exports("QUERY_TABLE") Set I_DELIMITER = RFC.exports("DELIMITER") Set I_NODATA = RFC.exports("NO_DATA") Set I_ROWSKIPS = RFC.exports("ROWSKIPS") Set I_ROWCOUNT = RFC.exports("ROWCOUNT") ' tableパラメータ Set IT_OPTIONS = RFC.Tables("OPTIONS") Set IT_FIELDS = RFC.Tables("FIELDS") Set IT_DATA = RFC.Tables("DATA") I_QUERY_TABLE.Value = "MARA" I_DELIMITER.Value = " " I_NODATA = " " I_ROWSKIPS = 0 I_ROWCOUNT = 0 IT_FIELDS.appendrow IT_FIELDS(1, "FIELDNAME") = "MATNR" IT_FIELDS.appendrow IT_FIELDS(2, "FIELDNAME") = "MTART" IT_FIELDS.appendrow IT_FIELDS(3, "FIELDNAME") = "MEINS" IT_OPTIONS.appendrow IT_OPTIONS(1, "TEXT") = "MATNR LIKE '" & "AA-%" & "'" Result = RFC.Call If Not Result Then ' エラーだったらエラーコード表示 MsgBox "実行エラー:" & RFC.Exception, vbCritical GoTo EndSyori Else End If '列名をExcelシートに出力 For iField = 1 To IT_FIELDS.RowCount Cells(1, iField).Value = IT_FIELDS(iField, "FIELDNAME") Next 'データをExcelシートに出力 iField = 1 For iRow = 1 To IT_DATA.RowCount For iField = 1 To IT_FIELDS.RowCount iStart = IT_FIELDS(iField, "OFFSET") + 1 iLength = IT_FIELDS(iField, "LENGTH") If iStart > Len(IT_DATA(iRow, "WA")) Then vField = Null Else vField = Mid(IT_DATA(iRow, "WA"), iStart, iLength) End If Select Case IT_FIELDS(iField, "TYPE") Case "C" Cells(iRow + 1, iField).Value = "'" & vField Case "D" Cells(iRow + 1, iField).Value = Format(vField, "@@@@/@@/@@") Case "T" Cells(iRow + 1, iField).Value = Format(vField, "@@:@@:@@") End Select Next Next MsgBox "ダウンロード件数 = " & IT_DATA.RowCount GoTo EndSyori 'エラー処理 MyError: MsgBox Err.Number & Err.Description, vbCritical EndSyori: sapConnection.Logoff Application.Cursor = xlDefault Application.StatusBar = False Set functionctrl = Nothing Set sapConnection = Nothing Set RFC = Nothing Set I_QUERY_TABLE = Nothing Set I_DELIMITER = Nothing Set I_NODATA = Nothing Set I_ROWSKIPS = Nothing Set I_ROWCOUNT = Nothing Set IT_OPTIONS = Nothing Set IT_FIELDS = Nothing Set IT_DATA = Nothing End Sub |