VBA Example for RSDRI_INFOPROV_READ_RFC

Share Button

VBA Example for RSDRI_INFOPROV_READ_RFC

I found during testing that FM RSDRI_INFOPROV_READ_RFC cannot be used directly in VBA as it sends an error when trying to do the command

Set oR3F = Module1.oFunction.Add(“RSDRI_INFOPROV_READ_RFC”)  à Message box: wdtfuncs SAP data type not supported

This is due to an Export Parameter that is String type (E_RFCDATA_UC) as found in SCN thread issue using the COM components supplied with SAP GUI 6.2 or 6.4

To overcome this issue, I copied RSDRI_INFOPROV_READ_RFC into ZBW_RSDRI_INFOPROV_READ_RFC removing that parameter and it now works. The code below contains a test for the function module, by running testFM you get data from a cube. Be aware this is a test only and you would need to refine it to have a loop calling the FM multiple times based on I_MAXROWS provided and the size of the specific result set.

For more information refer to the SAP Online Help Data Mart Interface

Below is all the code needed to wrap the function module and to test it.

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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

Public oConnection As Object     ' SAP/BW Connection
Public oFunction As Object       ' Function object
Public sDetMsg As String
Public sSysID As String
Public vBWConnStatus As Boolean  ' Status for BW connection
Public sEndOfData As String
 
Public Function RSDRI_INFOPROV_READ_RFC( _
ByVal i_infoprov As String, _
ByVal i_reference_date As String, _
ByRef i_t_sfc() As String, _
ByRef i_t_sfk() As String, _
ByRef i_t_range() As String) As String()
 
    Dim tableData() As String
    Dim oR3F As Object
'
    Dim Data As Object
    Dim sfc As Object
    Dim sfk As Object
    Dim myRange As Object
    Dim Line As Long
    Dim FuncResult As Integer
    Dim iRowCount As Integer
'A copy of the original function module removing export parameter
'E_RFCDATA_UC as it is String and it is not supported
    Set oR3F = Module1.oFunction.Add("ZBW_RSDRI_INFOPROV_READ_RFC")
    oR3F.Exports("I_INFOPROV") = i_infoprov
    oR3F.Exports("I_REFERENCE_DATE") = i_reference_date
    oR3F.Exports("I_RESULTTYPE") = "V"
 
    Set sfc = Nothing
    Set sfc = oR3F.Tables.Item("I_T_SFC")
    For i = 1 To UBound(i_t_sfc, 2)
        sfc.Rows.Add
        sfc(i, "CHANM") = Trim(i_t_sfc(1, i))
        sfc(i, "CHAALIAS") = Trim(i_t_sfc(2, i))
        sfc(i, "ORDERBY") = Trim(i_t_sfc(3, i))
    Next i
 
    Set sfk = Nothing
    Set sfk = oR3F.Tables.Item("I_T_SFK")
    For i = 1 To UBound(i_t_sfk, 2)
        sfk.Rows.Add
        sfk(i, "KYFNM") = Trim(i_t_sfk(1, i))
        sfk(i, "KYFALIAS") = Trim(i_t_sfk(2, i))
        sfk(i, "AGGR") = Trim(i_t_sfk(3, i))
    Next i
 
    Set myRange = Nothing
    Set myRange = oR3F.Tables.Item("I_T_RANGE")
    For i = 1 To UBound(i_t_range, 2)
        myRange.Rows.Add
        myRange(i, "CHANM") = Trim(i_t_range(1, i))
        myRange(i, "SIGN") = Trim(i_t_range(2, i))
        myRange(i, "COMPOP") = Trim(i_t_range(3, i))
        myRange(i, "LOW") = Trim(i_t_range(4, i))
        myRange(i, "HIGH") = Trim(i_t_range(5, i))
    Next i
 
  Set Data = Nothing
  Set Data = oR3F.Tables("E_T_RFCDATAV")
 
  FuncResult = oR3F.Call
 
    sEndOfData = oR3F.Imports("E_END_OF_DATA")
    If FuncResult = True And Data.RowCount > 0 Then
    'Fields: ID IOBJNM VALUE UNIT
        ReDim tableData(4, Data.RowCount)
        For Line = 1 To Data.RowCount
          tableData(1, Line) = Data(Line, "ID")
          tableData(2, Line) = Data(Line, "IOBJNM")
          tableData(3, Line) = Data(Line, "VALUE")
          tableData(4, Line) = Data(Line, "UNIT")
        Next
        RSDRI_INFOPROV_READ_RFC = tableData
    End If
 
  Set Data = Nothing
  Set sfc = Nothing
  Set sfk = Nothing
  Set myRange = Nothing
  Set oR3F = Nothing
 
    For i = 1 To oFunction.Count
        oFunction.Remove (1)
    Next i
End Function
Public Sub Logoff()
    If vBWConnStatus = False Then
        MsgBox "Not logged in"
    Else
      oFunction.Connection.Logoff
      vBWConnStatus = False
   End If
   Set oConnection = Nothing
   Set oFunction = Nothing
End Sub
Sub clearData()
    ActiveCell.SpecialCells(xlLastCell).Select
    iLastRow = Selection.Row
    If iLastRow >= 2 Then
        sRowRange = 2 & ":" & iLastRow
        Rows(sRowRange).Select
        Selection.Delete
        Range("A1").Select
    End If
End Sub
 
Sub testFM()
Dim myData() As String
Dim i_t_sfc() As String
Dim i_t_sfk() As String
Dim i_t_range() As String
 
Logon 'YOUR LOGON Sub
 
sEndOfData = ""
'In a real case scenario, it should do a while...loop until sEndOfData = "X"
 
If Month(Date) < 10 Then
    sMonth = "0" & Month(Date)
Else
    sMonth = Month(Date)
End If
If Day(Date) < 10 Then     sDay = "0" & Day(Date) Else     sDay = Day(Date) End If sDate = Year(Date) & sMonth & sDay ReDim i_t_sfc(3, 4) i_t_sfc(1, 1) = "0DISTR_CHAN" 'CHANM i_t_sfc(2, 1) = "0DISTR_CHAN" 'CHAALIAS i_t_sfc(3, 1) = "0" 'ORDERBY i_t_sfc(1, 2) = "0DIVISION" 'CHANM i_t_sfc(2, 2) = "0DIVISION" 'CHAALIAS i_t_sfc(3, 2) = "0" 'ORDERBY i_t_sfc(1, 3) = "0SALESORG" 'CHANM i_t_sfc(2, 3) = "0SALESORG" 'CHAALIAS i_t_sfc(3, 3) = "0" 'ORDERBY i_t_sfc(1, 4) = "0CALDAY" 'CHANM i_t_sfc(2, 4) = "0CALDAY" 'CHAALIAS i_t_sfc(3, 4) = "0" 'ORDERBY ReDim i_t_sfk(3, 1) i_t_sfk(1, 1) = "NET_VAL_S" 'KYFNM i_t_sfk(2, 1) = "NET_VAL_S" 'KYFALIAS i_t_sfk(3, 1) = "SUM" 'AGGR ReDim i_t_range(5, 1) i_t_range(1, 1) = "0CALDAY" 'CHANM i_t_range(2, 1) = "I" 'SIGN i_t_range(3, 1) = "BT" 'COMPOP i_t_range(4, 1) = "20110401" 'LOW i_t_range(5, 1) = "20110531" 'HIGH sWS = "MAIN" 'Rename to your worksheet name Sheets(sWS).Select Range("A1").Select Columns("A:D").Select Selection.ColumnWidth = 30 Selection.NumberFormat = "@" Range("A1").Select iRow = 1 iCol = 1 ActiveCell.SpecialCells(xlLastCell).Select iLastRow = Selection.Row If iLastRow >= iRow Then
    sRowRange = iRow & ":" & iLastRow
    Rows(sRowRange).Select
    Selection.Delete
End If
 
myData = RSDRI_INFOPROV_READ_RFC("0SD_C03", sDate, i_t_sfc, i_t_sfk, i_t_range)
iCount = UBound(myData, 2)
If iCount > 0 Then
    'First write the headers
 
    For i = 1 To UBound(i_t_sfc, 2)
        Worksheets(sWS).Cells(iRow, iCol + i - 1).Value = i_t_sfc(1, i)
    Next i
    iColNext = iCol + UBound(i_t_sfc, 2)
    For i = 1 To UBound(i_t_sfk, 2)
        Worksheets(sWS).Cells(iRow, iColNext + i - 1).Value = i_t_sfk(1, i)
    Next i
    iColTotal = UBound(i_t_sfc, 2) + UBound(i_t_sfk, 2)
 
    'Now the data
    iCol = 1
    For i = 1 To iCount
        sValue = ""
        sUnit = ""
        sValue = Trim(myData(3, i))
        sUnit = Trim(myData(4, i))
        If sUnit <> "" Then
            sValue = sValue + " " + sUnit
        End If
        Worksheets(sWS).Cells(iRow + myData(1, i), iCol).Value = sValue
        iCol = iCol + 1
        If iCol > iColTotal Then
            iCol = 1
        End If
    Next i
    Columns("A:D").Select
    Columns("A:D").EntireColumn.AutoFit
    Range("A1").Select
End If
 
Logoff 'YOUR LOGOFF SUB
 
End Sub
Share Button

No related posts.

Leave a Reply

Your email address will not be published. Required fields are marked *