【ABAP】エクセルからSAPデータの取得方法（RFC_READ_TABLE）

エクセルからSAPデータの取得する方法

SAPのデータを取得するにはRFC（Remote Function Call）と呼ばれる汎用モジュールがを使用し、Excelマクロを使って取得することが可能です。

RFCに対応したBAPIは、ABAP以外の外部システムから呼び出すことが可能です。
使用する汎用モジュールは「RFC_READ_TABLE」です。

サンプルソースコード

品目マスタMARAより取得しExcelに出力するサンプルです。
実行するとExcel上に新しいシートが作成されて、
項目名に続いてデータの内容が2行目以降にエクセル上に表示されます。

取得に必要なテーブル項目名を変更することで、
エクセルよりSAPのデータを取得することが可能です。

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

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")

'データを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

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

エクセルからSAPデータの取得する方法

サンプルソースコード

【ABAP】汎用モジュール「JOB_OPEN」の使い方

【ABAP】汎用モジュール「JOB_CLOSE」の使い方

【VBA】エクセルの各シートからシート名を取得する方法