SAP RFC関連

'RFC実行
Function RFC_READ_TABLE(Table_Value As String, Table_Query As String, ArrayHeader() As Variant) As Variant

Dim RET() As Variant
Dim DATA As Object
Dim FIELDS As Object
Dim OPTIONS As Object


'SAPにログオンする。
APServer = SAPSERVER_IPADORRESS
SAPClient = SAPClient
SAPUserID = SAP_ID
SAPUserPass = SAP_PASSWORD

' 接続のパラメータ入力
Set R3 = CreateObject("SAP.Functions")           ' 決まり文句(RFC用)
R3.Connection.ApplicationServer = "xxx.xxx.xxx.xxx"  ' xxx.xxx.xxx.xxx など
R3.Connection.Client = "mand"              ' クライアント番号
R3.Connection.user = "sapid"                   ' ユーザID
R3.Connection.Password = "password"            ' ログインパスワード
R3.Connection.Language = "JA"                 ' 言語

' ログイン実行
If R3.Connection.logon(0, True) <> True Then
    MsgBox "R/3 ログインに失敗しました"
    Exit Function
End If
'---------------------------------------------------------------
'汎用モジュール実行
'---------------------------------------------------------------

' ※ Set関数を利用し、各値に簡単にアクセス出来るようにする

' 実行する汎用モジュールの指定
Set rfcFunc = R3.Add("RFC_READ_TABLE")

' モジュールパラメータの設定
Set QUERY_TABLE = rfcFunc.Exports("QUERY_TABLE") ' EXPORTパラメータ設定
Set DELIMITER = rfcFunc.Exports("DELIMITER")
Set NO_DATA = rfcFunc.Exports("NO_DATA")
Set ROWSKIPS = rfcFunc.Exports("ROWSKIPS")
Set RowCount = rfcFunc.Exports("ROWCOUNT")
Set OPTIONS = rfcFunc.Tables("OPTIONS")          ' TABLESパラメータ設定
Set FIELDS = rfcFunc.Tables("FIELDS")

' パラメータに値を設定する(とりあえず必要最低限のみ)
QUERY_TABLE.Value = Table_Value                 ' テーブル VBAKを読み込む
DELIMITER.Value = "vbTab"                        ' 各列の値はカンマ区切りで返される
NO_DATA = " "                               ' データの無い列も取得
RowCount = 0                              ' 最大100行取得
ROWSKIPS = 0                                ' 先頭から連続で100行取得する

 ' 抽出する項目を指定

 ' SAPから抜いてくる項目名
 aryHeader = ArrayHeader()

 For i = 0 To UBound(aryHeader)
  Set oFields = rfcFunc.Tables("FIELDS").Rows.Add
  oFields.Value(1) = aryHeader(i)
 Next
 ' ------------------------------------------------------
 ' 抽出する条件を指定（条件は適宜変更して使ってください）
 Set oRow = rfcFunc.Tables("OPTIONS").Rows.Add
If Table_Query <> "" Then
oRow.Value(1) = Table_Query
End If
' 汎用モジュールの実行
Result = rfcFunc.Call
' 実行結果の成否判定

If Result = True Then
    ' 成功 → 値の取得準備を実施
    Set DATA = rfcFunc.Tables("DATA")
    Set FIELDS = rfcFunc.Tables("FIELDS")
    Set OPTIONS = rfcFunc.Tables("OPTIONS")
Else
    ' 失敗 → メッセージを表示し、ログアウトして終了
    MsgBox rfcFunc.Exception
    R3.Connection.Logoff
    Application.EnableEvents = True
    End
End If
'実行データを解析する
If DATA.RowCount <> 0 Then
    ' 取得したデータ件数分だけループ
ReDim RET(DATA.RowCount, UBound(ArrayHeader()))
    For iRow = 1 To DATA.RowCount
    ReDim sfield(FIELDS.RowCount)
        ' データフィールド数だけループ
        For iField = 1 To FIELDS.RowCount
            iStart = FIELDS(iField, "OFFSET") + 1   ' データ開始位置
            iLength = FIELDS(iField, "LENGTH")      ' データの長さ
            
            ' テーブルデータへのアクセスは 変数名(行番号, 列名) にて行える
            If iStart > Len(DATA(iRow, "WA")) Then
                vField = Null ' 値なし
            Else
                vField = Mid(DATA(iRow, "WA"), iStart, iLength)
                sfield(iField) = Mid(DATA(iRow, "WA"), iStart, iLength)
            End If
            RET(iRow - 1, iField - 1) = sfield(iField)
        Next
    Next
Else
ReDim RET(0, 0)
RET(0, 0) = False
End If

 RFC_READ_TABLE = RET()
End Function

'例）テーブルAUSPからある条件（オブジェクトキーを指定して）でデータ(特性名と特性値)を取得する。
Sub GetDataFromSAP()
Dim Table_Value As String
Dim Table_Query As String
Dim arr(1) As Variant
Dim RRT() As Variant

Table_Value = "AUSP"
Table_Query = "OBJEK = '0000000000078646566'"
arr(0) = "ATINN" '特性名
arr(1) = "ATWRT" '特性値

RRT = RFC_READ_TABLE(Table_Value, Table_Query, arr())

If RRT(0, 0) <> False Then
    RRTTEXT = ""
    For A = 0 To UBound(RRT, 1)
        For B = 0 To UBound(RRT, 2)
        RRTTEXT = RRTTEXT & ":" & RRT(A, B)
        Next
        RRTTEXT = Right(RRTTEXT, Len(RRTTEXT) - 1)
        Debug.Print RRTTEXT
        RRTTEXT = ""
    Next
Else
Debug.Print "データなし"
End If
End Sub

'ロングテキストを取得する汎用モジュールです。伝票やマスタ等に登録したテキストは普通のSQLでは取得できないため、当汎用モジュールでデータを取得します。
'オブジェクトIDはSTXHで調べてText IDをSE75で調べる
'TDNAMEは伝票番号と枝番の組み合わせ
Public Function ReadText(TDOBJECT As String, TDNAME As String, TDID As String) As String
Dim TDLINE As String

 Set RFC_READ_TEXT = R3.Add("RFC_READ_TEXT")
 Set tblText_Lines = RFC_READ_TEXT.Tables("TEXT_LINES")

 tblText_Lines.AppendRow
 tblText_Lines(1, "TDOBJECT") = TDOBJECT
 tblText_Lines(1, "TDNAME") = TDNAME
 tblText_Lines(1, "TDID") = TDID

 If RFC_READ_TEXT.Call = True Then
    
        If tblText_Lines.ROWCOUNT > 0 Then
        
            For intRow = 1 To tblText_Lines.ROWCOUNT
                TDLINE = TDLINE & " " & tblText_Lines(intRow, "TDLINE")
            Next
        Else
            TDLINE = ""
        End If
    Else
        'MsgBox "ERROR CALLING SAP REMOTE FUNCTION CALL"
    End If

'Result Table set back
 Do Until tblText_Lines.ROWCOUNT = 0
     Call tblText_Lines.Rows.Remove(1)
 Loop
 ReadText = TDLINE
 Set tblText_Lines = Nothing
End Function