Read Table Data from SAP into Excel Using RFCs
The ability to put into the hands of users an easy way to tease out of SAP data directly from tables has always been difficult in larger organizations because BASIS teams tend to disable SQ00 "because performance". Considering that larger organizations have dozens of front end servers and a query will consume a tiny percentage of one front end server's capacity for some seconds leads many to believe that the purpose of blocking this access is to eliminate support calls; eliminating a feature is easier than walking a user through creating a dataset and building a query.
In scenarios where the source tables are less than one million records long and the data can be knit together using vlookups, Excel can be used to tease data out of SAP using the RFC_READ_TABLE function. Where the data exceeds one million records, the preferred method is to use a similar function in Access and articles explaining that capacity are listed here.
- Create an Access Database File and Import a Text File to a Table Within Using VBA
- Import Unicode UTF-8 Text Directly into Access Using VBA
- Import tables directly into Access from SAP using RFCs
- Import a text file as a table in MS Access using VBA
The VBA code is relatively simple in this case. The connection to the SAP system has been moved outside into its own function and then each call to the next function recycles the same R3 connection.
Function GetR3(ByRef R3 As Object) As Boolean
Set R3 = CreateObject("SAP.Functions")
'*************************************
' Put in your own credentials here.
'*************************************
R3.Connection.System = "P01"
R3.Connection.SystemNumber = "00"
R3.Connection.client = "100"
R3.Connection.User = "" ' Put your User ID here if desired.
R3.Connection.Password = "" 'Put your password here (optional).
R3.Connection.LANGUAGE = "EN"
R3.Connection.ApplicationServer = "server-name.domain.int" 'Or IP address
If R3.Connection.logon(0, True) <> True Then
If R3.Connection.logon(0, False) <> True Then
GetR3 = False
Exit Function
End If
End If
GetR3 = True
End Function
Next, the function uses the R3 Connection to create a function object that is then used to tease out the data requested. The parameters passed in are the R3 Connector, the table in SAP, the tab name to be created (or replaced), the list of desired fields separated by comma and finally the options that will be discussed below.
Function SAP_RFC_READ_TABLE(ByRef R3 As Object, strSAPTable As String, strTabName As String, strFields As String, Optional ByVal strOptions As String = "") As Long
Dim strTemp As String
SAP_RFC_READ_TABLE = 0
'Create the database parallel to SAP's . . .
Dim nCounter As Long, nCurrent As Long
Dim nFieldData(999, 2) As Long, strSaveOptions As String
Dim strRow As String
Dim strFieldnames() As String
Dim strConvOptions() As String
Dim FinalRFCQuery As String
Dim vField As Variant
Dim j As Integer
Dim SQL As String
Dim nCurRec As Long, nCurSec As Long
Dim isUpdate As Boolean
Dim strFieldName As String
Dim nRowCount As Long
Dim nTotalRecords As Long
Dim RetVal As Variant, nSecondsLeft As Long, nTotalSeconds As Long
Dim MyFunc, App As Object
' Define the objects to hold IMPORT parameters
Dim QUERY_TABLE As Object
Dim DELIMITER As Object
Dim NO_DATA As Object
Dim ROWSKIPS As Object
Dim ROWCOUNT As Object
' Define the objects to hold the EXPORT parameters
' None for RFC_TABLE_READ
' Define the objects to hold the TABLES parameters
' Where clause
Dim OPTIONS As Object
' Fill with fields to return. After function call will hold
' detailed information about the columns of data (start position
' of each field, length, etc.
Dim FIELDS As Object
' Holds the data returned by the function
Dim DATA As Object
' Use to write out results
Dim ROW As Object
Dim Result As Boolean
Dim iRow, iColumn, iStart, iStartRow, iField, iLength As Integer
'***********************************
' Set up an offset and length loop.
'***********************************
Const nMaxRowCount = 250000
Dim nRowSkip
nRowSkip = 0
nTotalSeconds = 0
'*****************************************************
'Call RFC function RFC_READ_TABLE
'*****************************************************
Set MyFunc = R3.Add("RFC_READ_TABLE")
' Set the Objects to the parameter they will return
Set QUERY_TABLE = MyFunc.exports("QUERY_TABLE")
Set DELIMITER = MyFunc.exports("DELIMITER")
Set NO_DATA = MyFunc.exports("NO_DATA")
Set ROWSKIPS = MyFunc.exports("ROWSKIPS")
Set ROWCOUNT = MyFunc.exports("ROWCOUNT")
Set OPTIONS = MyFunc.Tables("OPTIONS")
OPTIONS.Rows.RemoveAll
Set FIELDS = MyFunc.Tables("FIELDS")
FIELDS.Rows.RemoveAll
QUERY_TABLE.Value = strSAPTable
DELIMITER.Value = vbTab
NO_DATA = ""
ROWSKIPS.Value = nRowSkip
ROWCOUNT.Value = nMaxRowCount
'Quebrando o nome dos campos
j = 0
strFieldnames = Split(strFields, ",")
For Each vField In strFieldnames
j = j + 1
FIELDS.Rows.Add
FIELDS.Value(j, "FIELDNAME") = Trim(UCase(vField))
Next
'Quebrando Lendo condições Where
j = 0
If strOptions <> "" Then
stroption = UCase(strOptions)
'If InStr(strOptions, " OR ") Then
' strConvOptions = Split(strOptions, " OR ")
Do While Len(strOptions) > 0
For nCurrent = 1 To Len(strOptions)
'OPTIONS.Value(j, 1) = OPTIONS.Value(j, 1) & Left(strOptions, 1)
'strOptions = Mid(strOptions, 2, 9999)
'If Right(OPTIONS.Value(j, 1), 4) = " OR " Or Right(OPTIONS.Value(j, 1), 5) = " AND " Then
If Right(Left(strOptions, nCurrent), 4) = " OR " Or Right(Left(strOptions, nCurrent), 5) = " AND " Then
'Break the option here and start a new one.
OPTIONS.Rows.Add
j = j + 1
OPTIONS.Value(j, 1) = Left(strOptions, nCurrent)
strOptions = Mid(strOptions, nCurrent + 1, 9999)
Exit For
Else
If nCurrent = Len(strOptions) Then
'This is the last Option.
OPTIONS.Rows.Add
j = j + 1
OPTIONS.Value(j, 1) = strOptions
strOptions = ""
End If
End If
Next
Loop
End If
RetVal = DoEvents
Result = MyFunc.Call
If Result = True Then
Set DATA = MyFunc.Tables("DATA")
Set FIELDS = MyFunc.Tables("FIELDS")
Set OPTIONS = MyFunc.Tables("OPTIONS")
Else
MsgBox MyFunc.EXCEPTION
'R3.Connection.logoff
Exit Function
End If
nTotalColumns = FIELDS.ROWCOUNT
For iField = 1 To FIELDS.ROWCOUNT
nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
Next
'Create the requested Tab.
Dim wsOutput As Worksheet
Set wsOutput = CreateTab(strTabName)
Dim nCurrentRow As Long
Dim strColumn As String, strCell As String, strRange As String
'Freeze the top row...
Application.ScreenUpdating = True
ActiveWindow.FreezePanes = False
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
iField = 1
nRowCount = FIELDS.ROWCOUNT
strFields = "X"
For iField = 1 To nRowCount
nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
If iField > 1 Then
strFields = strFields & ",X"
End If
Next
Dim strFieldValues() As String 'Used later to speed up writes to ranges.
strFieldValues = Split(strFields, ",")
Do While DATA.ROWCOUNT > 0
For iRow = 1 To DATA.ROWCOUNT
If nTotalRecords < 1048575 Then
nTotalRecords = nTotalRecords + 1
strRow = DATA(iRow, 1) 'Pull this into a string rather than pull it from DATA each time...
'Add the row to the spreadsheet.
For iField = 1 To nRowCount
'wsOutput.Range(strCell).NumberFormat = "@" 'Format the cell as text.
'wsOutput.Range(strCell).Value = Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
strFieldValues(iField - 1) = Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
Next
If nRowCount < 27 Then
strColumn = Chr(64 + nRowCount)
Else
strColumn = Chr(64 + Int(nRowCount / 26)) & Chr(64 + nRowCount - (26 * (Int(nRowCount / 26))))
End If
strCell = strColumn & Trim(1 + nTotalRecords)
strRange = "A" & Trim(1 + nTotalRecords) & ":" & strCell
wsOutput.Range(strRange).NumberFormat = "@" 'Format the cell as text.
wsOutput.Range(strRange).Value = strFieldValues 'Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
If Second(Now()) <> nCurSec Then ' And nCurRec <> rs.RecordCount Then
nCurSec = Second(Now())
wsOutput.Range("A1").Value = nTotalRecords & " records"
If nCurSec / 2 = Int(nCurSec / 2) Then
wsOutput.Range("A1").Interior.Color = RGB(255, 255, 0)
Else
wsOutput.Range("A1").Interior.Color = RGB(233, 233, 0)
End If
RetVal = DoEvents()
End If
End If
Next
'***********************************************************
' Check to see if the function should be called again . . .
'***********************************************************
If DATA.ROWCOUNT < nMaxRowCount Then
'There is no need to read again to get a zero value.
Exit Do
Else
'Set the offset to read the next block.
nRowSkip = nRowSkip + nMaxRowCount
End If
'***********************************************************
' Call the function again to get the next block of records.
'***********************************************************
ROWSKIPS.Value = nRowSkip
ROWCOUNT.Value = nMaxRowCount
MyFunc.Tables("DATA").Rows.RemoveAll 'Special thanks to Mike Burnett
Result = MyFunc.Call
Set DATA = MyFunc.Tables("DATA")
Set FIELDS = MyFunc.Tables("FIELDS")
Set OPTIONS = MyFunc.Tables("OPTIONS")
Loop
strCell = "A2"
wsOutput.Range(strCell).Show
For iField = 1 To FIELDS.ROWCOUNT
If iField < 27 Then
strColumn = Chr(64 + iField)
Else
strColumn = Chr(64 + Int((iField - 1) / 26)) & Chr(64 + iField - (26 * (Int((iField - 1) / 26))))
End If
strCell = strColumn & "1"
wsOutput.Range(strCell).Value = FIELDS(iField, "FIELDNAME")
wsOutput.Range(strCell).Font.Bold = True
wsOutput.Range(strCell).Interior.Color = RGB(222, 222, 222)
RetVal = DoEvents()
Next
'rs.Close
'Close #2
'Set dbs = Nothing
'Set rs = Nothing
'RetVal = SysCmd(acSysCmdRemoveMeter)
'*****************************************
' Log off of the SAP system and clean up.
'*****************************************
DATA.Rows.RemoveAll
Set DATA = Nothing
FIELDS.Rows.RemoveAll
Set FIELDS = Nothing
OPTIONS.Rows.RemoveAll
Set OPTIONS = Nothing
Set MyFunc = Nothing
'R3.Connection.logoff
'Set R3 = Nothing
SAP_RFC_READ_TABLE = nTotalRecords
End Function
Function NukeTab(strTabName) As Boolean
Dim objCurrentSheet As Worksheet
For Each objCurrentSheet In Sheets
If objCurrentSheet.Name = strTabName Then
Application.DisplayAlerts = False
objCurrentSheet.Delete
Application.DisplayAlerts = True
NukeTab = True
Exit Function
End If
Next
NukeTab = False
End Function
Function CreateTab(strTabName) As Worksheet
Dim objCurrentSheet As Worksheet
For Each objCurrentSheet In Sheets
If objCurrentSheet.Name = strTabName Then
Application.DisplayAlerts = False
objCurrentSheet.Delete
Application.DisplayAlerts = True
Exit For
'Set CreateTab = objCurrentSheet
'Exit Function
'Sheets. (objCurrentSheet)
End If
Next
Set CreateTab = Sheets.Add
CreateTab.Name = strTabName
End Function
At the end of the code block above are the NukeTab and the CreateTab function. The NukeTab deletes a Worksheet when it exists. The CreateTabcreates a blank Worksheet in the current spreadsheet (after deleting one of the same name if necessary) and passes a return value that is a Worksheet object.
The OPTIONS parameter that is passed to the RFC is passed in as an internal table. These data act like a WHERE statement without the word "WHERE" and can be used to filter the data like in the examples below.
nRecordCount = SAP_RFC_READ_TABLE(R3, "T134M", "tblT134M", "", "BWKEY like '1%' or BWKEY like '3%'")
nMaterials = SAP_RFC_READ_TABLE(R3, "MARA", "tempMARA", "MATNR,MTART,MATKL,MEINS,NTGEW,BRGEW,GEWEI,PRDHA", "MSTAE EQ '4' AND MTART EQ '" & strMTART & "'")
Handling extracts that exceed Excel's row limit
In some cases, the number of records exceeds 1,048,575; that is the maximum number of data rows in an Excel spreadsheet when using headers. In that case, some simple code can be used to create a new addressing system to poke and peek data into a spreadsheet in a linear fashion.
As an example, these functions below can be used to tease MARC data out of an SAP system when the volume exceeds Excel's row limit. Each one is explained individually.
This first function accepts the R3 connection and a range as parameters. The range includes the Material Masters for which the Plant data will be extracted.
The concatenates a reasonable number of Material Master numbers along with "OR" statements. This allows for more records than are allowed in an IN SQL statement with an array.
This function also teases out the MARD entries and concatenates them as a field on the row in Excel. Finally, the function calls the SetMARC function to poke the record into a larger Worksheet.
Function PopulateMARCbyMATNR(ByRef R3 As Object, objRange As Range) As Long
Dim nCountMARA As Long, objCell As Object, strMaterial As String, strMaterialFilter As String, nMaterials As Long, nCurrentRow As Long
Dim nCurSec As Integer, strSkipMaterials As String, strSkipPlants As String, nCurrent As Long
Const strGetFields As String = "MATNR,WERKS,PSTAT,AUSME,DISMM,DISPO,DISLS,BESKZ,SOBSL,LOSGR,SOBSK,LGPRO,DISGR,LGFSB"
Dim nLGORTs As Long, nCurrentLGORT As Long, strLGORTs As String, strOptions As String
For Each objCell In objRange.Cells
If objCell.Value <> "" Then
strMaterial = objCell.Value
If InStr(strMaterialFilter, strMaterial) < 1 And InStr(strSkipMaterials, objCell.Value) < 1 Then
If strMaterialFilter = "" Then
strMaterialFilter = "MATNR EQ '" & strMaterial & "'"
Else
strMaterialFilter = strMaterialFilter & " OR MATNR EQ " & "'" & strMaterial & "'"
End If
strSkipMaterials = strSkipMaterials & "," & objCell.Value
End If
If Len(strMaterialFilter) > 4000 Then
a = CreateLogEntry("Pulling MARC entries for " & strMaterialFilter)
nMaterials = SAP_RFC_READ_TABLE(R3, "MARC", "tempMARC", strGetFields, strMaterialFilter)
If nMaterials > 0 Then
nLGORTs = SAP_RFC_READ_TABLE(R3, "MARD", "tempMARD", "MATNR,WERKS,LGORT", strMaterialFilter)
a = SortByFirstTwoColumns("tempMARC", nMaterials)
a = SortByFirstTwoColumns("tempMARD", nLGORTs)
For nCurrentRow = 2 To nMaterials + 1
strLGORTs = GetLGORTs(Sheets("tempMARC").Range("A" & nCurrentRow).Value, Sheets("tempMARC").Range("B" & nCurrentRow).Value)
Sheets("tempMARC").Range("O" & nCurrentRow).Value = strLGORTs
nCountMARC = SetMARC(Sheets("tempMARC").Range("A" & nCurrentRow & ":O" & nCurrentRow))
If nCurSec <> Second(Now) Then
nCurSec = FlashTab("MARC")
End If
Next
End If
strMaterialFilter = ""
End If
End If
If nCurSec <> Second(Now) Then
nCurSec = FlashTab("MARC")
End If
Next
If strMaterialFilter <> "" Then
a = CreateLogEntry("Pulling MARC entries for " & strMaterialFilter)
nMaterials = SAP_RFC_READ_TABLE(R3, "MARC", "tempMARC", strGetFields, strMaterialFilter)
If nMaterials > 0 Then
nLGORTs = SAP_RFC_READ_TABLE(R3, "MARD", "tempMARD", "MATNR,WERKS,LGORT", strMaterialFilter)
a = SortByFirstTwoColumns("tempMARC", nMaterials)
a = SortByFirstTwoColumns("tempMARD", nLGORTs)
For nCurrentRow = 2 To nMaterials + 1
strLGORTs = GetLGORTs(Sheets("tempMARC").Range("A" & nCurrentRow).Value, Sheets("tempMARC").Range("B" & nCurrentRow).Value)
Sheets("tempMARC").Range("O" & nCurrentRow).Value = strLGORTs
nCountMARC = SetMARC(Sheets("tempMARC").Range("A" & nCurrentRow & ":O" & nCurrentRow))
If nCurSec <> Second(Now) Then
nCurSec = FlashTab("MARC")
End If
Next
End If
strMaterialFilter = ""
End If
If nMaterials > 0 Then
Sheets("MARC").Range("A1:O1").Value = Sheets("tempMARC").Range("A1:O1").Value
Sheets("MARC").Range("O1").Value = "LGORTS"
Sheets("MARC").Range("A1:O1").Font.Bold = True
Sheets("MARC").Range("A1:O1").Interior.Color = RGB(222, 222, 222)
End If
nCurrent = NukeTab("tempMARC")
nCurrent = NukeTab("tempMARD")
Sheets("MARA").Tab.Color = RGB(222, 222, 22)
PopulateMARCbyMATNR = nCountMARA
End Function
The GetLGORTs function is simple enough. It combs through the records in the tempMARD tab of the current spreadsheet to concatenate all of the storage locations associated with an Material Master and Plant combination.
It relies on the values in the spreadsheet to be sorted by Material Master number. The code in the SortByFirstTwoColums function (which is documented below this one) sorts these quickly so that this function works.
Function GetLGORTs(strMATNR As String, strWERKS As String) As String
Dim nCurrent As Long, strLGORTs As String
Static nCurrentLGORT As Long
If Sheets("tempMARD").Range("A1").Interior.Color <> RGB(222, 222, 0) Then
Sheets("tempMARD").Range("A1").Interior.Color = RGB(222, 222, 0)
nCurrentLGORT = 1
End If
If strMATNR = "" Then
Exit Function
End If
Do While Sheets("tempMARD").Range("A" & nCurrentLGORT + 1).Value < strMATNR
nCurrentLGORT = nCurrentLGORT + 1
If Sheets("tempMARD").Range("A" & nCurrentLGORT + 1).Value = "" Then
nCurrentLGORT = 1
Exit Function
End If
Loop
Do While Sheets("tempMARD").Range("A" & nCurrentLGORT + 1).Value = strMATNR And Sheets("tempMARD").Range("B" & nCurrentLGORT + 1).Value < strWERKS
nCurrentLGORT = nCurrentLGORT + 1
If Sheets("tempMARD").Range("A" & nCurrentLGORT + 1).Value = "" Then
nCurrentLGORT = 1
Exit Function
End If
Loop
strLGORTs = ""
Do While Sheets("tempMARD").Range("A" & nCurrentLGORT + 1).Value = strMATNR And Sheets("tempMARD").Range("B" & nCurrentLGORT + 1).Value = strWERKS
strLGORTs = strLGORTs & Sheets("tempMARD").Range("C" & nCurrentLGORT + 1).Value
nCurrentLGORT = nCurrentLGORT + 1
Loop
GetLGORTs = strLGORTs
End Function
The SortByFirstTwoColumns is an ultra-simple and very fast way to sort rows in an Excel spreadsheet by the first two columns which is usually enough. It accepts as its parameters the name of the Worksheet (strTabName) to be sorted and the number of records to be sorted (nRows); the SAP_RFC_READ_TABLE function returns a long which is the number of entries it retrieved and that value is passed to this function instead of using logic to find the number of records.
Function SortByFirstTwoColumns(strTabName As String, nRows As Long) As Boolean
ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("A2:A" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("B2:B" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(strTabName).Sort
.SetRange Range("A2:Z" & (1 + nRows))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Function
The SetMARC function pokes the data in an addressable way into a larger Worksheet in order to exceed Excel's limit on rows. It keeps a static counter and incrments it each time the function is called.
Function SetMARC(objRange As Range) As Long
Static nCountMARC As Long, wsMARC As Worksheet, nCurrentSet As Long, nCurrent As Long, nCurrentLine As Long
Dim nRangeLength As Long, nStart As Long
'Const nSetWidth As Long = 30
Set wsMARC = Sheets("MARC")
If wsMARC.Range("A2").Value = "" Then
nCountMARC = 0 'Refreshed!
End If
If nCountMARC = 0 Or objRange.Cells.Count = 1 Then
For nCurrentSet = 21 To 0 Step -1
If wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), 2)).Value <> "" Then
nCountMARC = 1000000 * nCurrentSet
If nCurrentSet = 0 Then
nStart = 2
Else
nStart = 1
End If
For nCurrent = nStart To 1048000
If wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), nCurrent)).Value <> "" Then
nCountMARC = nCountMARC + 1
Else
Exit For
End If
If nCurSec <> Second(Now) Then
nCurSec = Second(Now)
RetVal = DoEvents
End If
Next
Exit For
End If
Next
End If
If objRange.Cells.Count > 1 Then
nCountMARC = nCountMARC + 1
nCurrentSet = Int(nCountMARC / 1000000)
nCurrentLine = nCountMARC - Int(nCurrentSet * 1000000)
'If nCurrentLine > 1000000 Then
' nCurrentSet = nCurrentSet + 1
' nCurrentLine = nCountMARC - Int(nCurrentSet * 1000000)
'End If
nRangeLength = objRange.Cells.Count
wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), 1 + nCurrentLine) & ":" & FindExcelCell(nRangeLength + (nCurrentSet * nSetWidth), 1 + nCurrentLine)).NumberFormat = "@"
wsMARC.Range(FindExcelCell(1 + (nCurrentSet * nSetWidth), 1 + nCurrentLine) & ":" & FindExcelCell(nRangeLength + (nCurrentSet * nSetWidth), 1 + nCurrentLine)).Value = objRange.Value
End If
SetMARC = nCountMARC
End Function
Finally, the GetMARC function peeks the data out of the Worksheet using an integer representing the record number in a linear fashion. This function and the SetMARC function rely on a global variable called nSetWidth which is delcared as a constant outside of any function or sub.
Const nSetWidth As Long = 30
Function GetMARC(nCurrent As Long, strField As String) As String
Static nCountMARC As Long, wsMARC As Worksheet, nCurrentSet As Long, nCurrentLine As Long
'Static nLastCurrent As Long, strLastField As String, strLastValue As String
Dim nCurrentColumn As Long
Static strColumns(70) As String
'Const nSetWidth As Long = 30
'If nCurrent = 0 Then
' GetMARC = ""
' Exit Function
'End If
If strColumns(1) = "" Then
For nCurrentColumn = 1 To 70
strColumns(nCurrentColumn) = Sheets("MARC").Range(FindExcelCell(nCurrentColumn, 1)).Value
Next
End If
nCurrentSet = Int(nCurrent / 1000000)
nCurrentLine = nCurrent - (1000000 * nCurrentSet)
For nCurrentColumn = 1 To 70
If strColumns(nCurrentColumn) = strField Then
Exit For
End If
Next
GetMARC = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + nCurrentColumn, nCurrentLine + 1)).Value
End Function
Organize this data so it can be read much faster
Rather than reading linearly through millions of Plant extension records to find those associated with a particular Material Master, the records can be sorted and then teased out using a for/next loop that starts at the first record and ends at the last record. This shaves hours off of processing and can be done relatively simply.
This sub sorts the MARC records while doing its best to conserve memory. It uses a System.Collections.ArrayList to sneakily sort millions of records in mere seconds instead of using nested loops and spending hours swapping cells in the spreadsheet.
Sub SortMARC()
Dim nCurrentColumn As Long, nCurrent As Long, nCurrent2 As Long, nCurSec As Long
Dim nCountMARC As Long, strTemp As Variant
Dim nCurrentSet As Long, nCurrentLine As Long
Dim nCurrentSet2 As Long, nCurrentLine2 As Long
Static strColumns(70) As String
'Const nSetWidth As Long = 30
'Get the number of Plant extensions in the MARC tab...
nCountMARC = SetMARC(Range("ZZ9"))
'Set these to be stored as text.
'Sheets("MARC").Range(FindExcelCell(1, 1048570) & ":" & FindExcelCell(70, 1048570)).NumberFormat = "@"
Sheets("MARC").Range("A1048570").Value = "Sorted"
Dim arr As Object
Dim cell As Range
Set arr = CreateObject("System.Collections.ArrayList")
For nCurrent = 1 To nCountMARC
nCurrentSet = Int(nCurrent / 1000000)
nCurrentLine = nCurrent - (1000000 * nCurrentSet)
strTemp = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1)).Value & Right("000000000" & nCurrent, 9)
arr.Add strTemp
If nCurSec <> Second(Now) Then
nCurSec = Second(Now)
If nCurSec / 2 = Int(nCurSec / 2) Then
Sheets("MARC").Tab.Color = RGB(222, 22, 222)
Else
Sheets("MARC").Tab.Color = RGB(111, 11, 111)
End If
RetVal = DoEvents
End If
Next
arr.Sort
Dim wsTemp As Worksheet
Set wsTemp = CreateTab("tempMARC")
nCurrent = 0
For Each strTemp In arr
nCurrent = nCurrent + 1
nCurrent2 = Val(Mid(strTemp, 19, 9))
If nCurrent <> nCurrent2 Then
nCurrentSet = Int(nCurrent / 1000000)
nCurrentLine = nCurrent - (1000000 * nCurrentSet)
nCurrentSet2 = Int(nCurrent2 / 1000000)
nCurrentLine2 = nCurrent2 - (1000000 * nCurrentSet2)
Sheets("tempMARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).NumberFormat = "@"
Sheets("tempMARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value = Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value
If nCurrent2 < nCurrent Then
Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value = Sheets("tempMARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Value
Sheets("tempMARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Clear
Else
Sheets("MARC").Range(FindExcelCell((nCurrentSet * nSetWidth) + 1, nCurrentLine + 1) & ":" & FindExcelCell((nCurrentSet * nSetWidth) + nSetWidth, nCurrentLine + 1)).Value = Sheets("MARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Value
End If
'Sheets("MARC").Range(FindExcelCell((nCurrentSet2 * nSetWidth) + 1, nCurrentLine2 + 1) & ":" & FindExcelCell((nCurrentSet2 * nSetWidth) + nSetWidth, nCurrentLine2 + 1)).Value = Sheets("MARC").Range(FindExcelCell(1, 1048570) & ":" & FindExcelCell(70, 1048570)).Value
End If
If nCurSec <> Second(Now) Then
nCurSec = Second(Now)
If nCurSec / 2 = Int(nCurSec / 2) Then
Sheets("MARC").Tab.Color = RGB(222, 22, 222)
Else
Sheets("MARC").Tab.Color = RGB(111, 11, 111)
End If
Sheets("tempMARC").Range("A1").Value = "Sorting... " & Int(100 * (nCurrent / nCountMARC)) & "% completed."
RetVal = DoEvents
End If
Next
Set arr = Nothing
a = NukeTab("tempMARC")
End Sub
When the GetMARCRange function is called, it combs through the data to find the first instance of the Material Master and then the last and then returns the two values as an 18-digit string value. The first nine digits are the first instance of the Material Master and the last nine digits are the last and can be called as in the sample code below.
Function CountMARCEntries(strMATNR as string) as long
Dim strRange as string, nCurrent as long, nCount as long
nCount = 0
strRange = GetMARCRange(strMATNR)
For nCurrent = Val(Left(strRange, 9)) To Val(Right(strRange, 9))
nCount = nCount + 1
Next
CountMARCEntries = nCount
End Function
Function GetMARCRange(strMATNR As String) As String
Static nCount As Long, strRanges(999999, 1) As String, nCountMARC As Long
Static strLastMATNR As String, nLastLast As Long, nStart As Long
Dim nCurrent As Long, nFirst As Long, nLast As Long, nCurrentMATNR As String
nStart = 1
If Sheets("MARC").Range("A1048570").Value <> "" Then
'This was just sorted. Start from scratch...
Sheets("MARC").Range("A1048570").Value = ""
nCount = 0
nCountMARC = 0
nLastLast = 1
End If
For nCurrent = 1 To nCount
If strRanges(nCurrent, 1) = strMATNR Then
GetMARCRange = strRanges(nCurrent, 0)
Exit Function
End If
Next
If nCountMARC = 0 Then
nCountMARC = SetMARC(Range("ZZ9"))
End If
'Seriously speed this process up . . .
If strLastMATNR < strMATNR And nLastLast <> 0 Then
nStart = nLastLast
Else
For nCurrent = 1000 To nCountMARC - 2000 Step 1000
If GetMARC(nCurrent, "MATNR") < strMATNR Then
nStart = nCurrent
Else
Exit For
End If
Next
End If
nFirst = 0
nLast = 0
For nCurrent = nStart To nCountMARC
If GetMARC(nCurrent, "MATNR") = strMATNR Then
If nFirst = 0 Then
nFirst = nCurrent
End If
nLast = nCurrent
Else
If nLast > 0 Then
Exit For
End If
If GetMARC(nCurrent, "MATNR") > strMATNR Then
'The Material Master isn't in this list.
Exit For
End If
End If
Next
nCount = nCount + 1
strRanges(nCount, 1) = strMATNR
strRanges(nCount, 0) = Right("000000000" & nFirst, 9) & Right("000000000" & nLast, 9)
GetMARCRange = strRanges(nCount, 0)
strLastMATNR = strMATNR
nLastLast = nLast
End Function
Update: Solving the SAPSQL_DATA_LOSS problem
After a recent update, the RFC began throwing this SAPSQL_DATA_LOSS error; code that worked for years suddenly stopped working, so some debugging was in order. The problem was first noticed on May 1st, 2023 and presented itself as a RFC_COMMUNICATION_FAILURE error or SAPSQL_DATA_LOSS error or both.
It didn't take long to figure out that the problem was being caused by OPTIONS being passed in with values that were longer than the field being compared. An good example that came from knitting the WHERE statements from columnized data with headers was VKORG eq 'VKORG'.
Once the five-character header row was removed from the data being passed into the function, the code began to work again. The supplemental code below was enough to prevent the header from being passed into the RFC_READ_TABLE function as a line in the OPTIONS parameter.
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'* *
'* This function pulls a list of Sales Area extensions *
'* associated with the Sales Orgs provided. *
'* *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
nRangeCount = objRange.Cells.Count
For Each objCell In objRange.Cells
nRangeCurrent = nRangeCurrent + 1
'If objCell.Value <> "" Then
strVKORG = objCell.Value
If InStr(strVKORGFilter, strVKORG) < 1 And InStr(strSkipVKORGs, strVKORG) < 1 and strVKORG <> 'VKORG' Then
If strVKORGFilter = "" Then
strVKORGFilter = "VKORG EQ '" & strVKORG & "'"
Else
strVKORGFilter = strVKORGFilter & " OR VKORG EQ " & "'" & strVKORG & "'"
End If
strSkipVKORGs = strSkipVKORGs & "," & objCell.Value
End If
If Len(strVKORGFilter) > 4000 Or (Len(strVKORGFilter) > 1 And nRangeCurrent = nRangeCount) Then
a = CreateLogEntry("Pulling MARC entries for " & strVKORGFilter)
nMaterials = SAP_RFC_READ_TABLE(R3, "MVKE", "tempMVKE", strGetFields, strVKORGFilter)
If nMaterials > 0 Then
a = SortByFirstThreeColumns("tempMVKE", nMaterials)
For nCurrentRow = 2 To nMaterials + 1
'strLGORTs = GetLGORTs(Sheets("tempMARC").Range("A" & nCurrentRow).Value, Sheets("tempMARC").Range("B" & nCurrentRow).Value)
'Sheets("tempMARC").Range("O" & nCurrentRow).Value = strLGORTs
nCountMVKE = SetMVKE(Sheets("tempMVKE").Range("A" & nCurrentRow & ":O" & nCurrentRow))
If nCurSec <> Second(Now) Then
nCurSec = FlashTab("MVKE")
End If
Next
End If
strVKORGFilter = ""
End If
'End If
'If nCurSec <> Second(Now) Then
' nCurSec = FlashTab("MVKE")
'End If
Next
