简体   繁体   中英

VBA (RFC) SAP export to excel

I am writing a VB application for connecting to a sap system (using rfc). Everything works fine and I do get a connection and the data as well.

Nevertheless the code for saving the accessed data and writing it to a excel file is really slow.

After the connection I call RFC_READ_TABLE, which returns with a result in <5 secs, which is perfect. Writing to excel (cell by cell) is pretty slow. Is there any way to 'export' the whole tblData to excel and not being dependent on writing cell by cell?

Thanks in advance!

If RFC_READ_TABLE.Call = True Then
    MsgBox tblData.RowCount
    If tblData.RowCount > 0 Then

        ' Write table header
        For j = 1 To Size
            Cells(1, j).Value = ColumnNames(j)
        Next j

        Size = UBound(ColumnNames, 1) - LBound(ColumnNames, 1) + 1

        For i = 1 To tblData.RowCount
            DoEvents
            Textzeile = tblData(i, "WA")

            For j = 1 To Size
                Cells(i + 1, j).Value = LTrim(RTrim(getPieceOfTextzeile(Textzeile)))
            Next j

       Next
    Else
       MsgBox "No entries found in system " & SYSID, vbInformation
    End If

Else
   MsgBox "ERROR CALLING SAP REMOTE FUNCTION CALL"
End If

Arrays: Faster Than Ranges

If the data was ready (need not to be processed) something like this could be a solution:

Sub Sap()

    Const cStrStart As String = "A1" 'First cell of the resulting data

    Dim tbldata
    Dim arrSap As Variant 'Will become a one-based two dimensional array
    Dim oRng As Range

        arrSap = tbldata 'Data is in the array.

        'Calculate the range: Must be the same size as arrSap
        Set oRng = Range(Cells(Range(cStrStart).Row, UBound(arrSap)), _
            Cells(Range(cStrStart)).Column, UBound(arrSap, 2))

        oRng = arrSap 'Paste array into range.

End Sub

Since you need to process your data from tbldata do what you do not to the range, but to an array which should be much faster:

Sub Sap()

    Const cStrStart As String = "A1" 'First cell of the resulting data

    Dim arrSap() As Variant
    Dim oRng As Range
    Dim Size As Integer

    If RFC_READ_TABLE.Call = True Then
'-------------------------------------------------------------------------------
        MsgBox tbldata.RowCount
        If tbldata.RowCount > 0 Then
            Size = UBound(ColumnNames, 1) - LBound(ColumnNames, 1) + 1
            ReDim arrSap(1 To tbldata.RowCount + 1, 1 To Size) '+ 1 for header
            ' Write table header
            For j = 1 To Size
                arrSap(1, j).Value = ColumnNames(j)
            Next j
            ' Write data
            For i = 1 + 1 To tbldata.RowCount + 1 '+ 1 for header
                DoEvents
                '- 1 due to header, don't know what "WA" is
                Textzeile = tbldata(i - 1, "WA")
                For j = 1 To Size
                    arrSap(i, j) = _
                        LTrim(RTrim(getPieceOfTextzeile(Textzeile)))
                Next j
            Next
'-------------------------------------------------------------------------------
            'Calculate the range: Must be the same size as arrSap
            Set oRng = Range(Cells(Range(cStrStart).Row, Range(cStrStart).Column), _
                Cells(UBound(arrSap) + Range(cStrStart).Row -1, _
                UBound(arrSap, 2) + Range(cStrStart).Column -1))
            oRng = arrSap
'-------------------------------------------------------------------------------
        Else
            MsgBox "No entries found in system " & SYSID, vbInformation
        End If
    Else
        MsgBox "ERROR CALLING SAP REMOTE FUNCTION CALL"
    End If

End Sub

Now adjust the cStrStart, check the rest of the code and you're good to go.
I haven't created a working example so I edited this code a few times. Check it carefully not to lose data.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM