[英]VBA (RFC) SAP export to excel
I am writing a VB application for connecting to a sap system (using rfc).我正在编写一个用于连接到 sap 系统的 VB 应用程序(使用 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.尽管如此,保存访问数据并将其写入excel文件的代码确实很慢。
After the connection I call RFC_READ_TABLE, which returns with a result in <5 secs, which is perfect.连接后我调用 RFC_READ_TABLE,它在 <5 秒内返回结果,这是完美的。 Writing to excel (cell by cell) is pretty slow.
写入 excel(逐个单元格)非常慢。 Is there any way to 'export' the whole tblData to excel and not being dependent on writing cell by cell?
有什么方法可以将整个 tblData '导出' 到 excel 并且不依赖于逐个单元地写入?
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
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:由于您需要从 tbldata 处理您的数据,因此您不需要对范围执行任何操作,而是处理应该更快的数组:
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.现在调整 cStrStart,检查其余的代码,你就可以开始了。
I haven't created a working example so I edited this code a few times.我还没有创建一个工作示例,所以我编辑了几次这段代码。 Check it carefully not to lose data.
仔细检查以免丢失数据。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.