By GuestUser - 10/19/2004
Hi, I am trying to call a transaction (ME32K) in SAP system through a Macro in Excel spread sheet. I provided data in Rows and Columns. Once I run Macro, it is processing only one row instead of all rows until the next row is empty. I attached spread sheet. See the logic below. -------------------------- Dim j As Integer Public Sub add_bdcdata(BdcTable As Object, program As String, dynpro As String, dynbegin As String, fnam As String, fval As String)
Dim vField As Variant j = j + 1 BdcTable.Rows.Add BdcTable.Value(j, "PROGRAM") = program ' Program Name BdcTable.Value(j, "DYNPRO") = dynpro ' Dynpro Number BdcTable.Value(j, "DYNBEGIN") = dynbegin ' X if a screen BdcTable.Value(j, "FNAM") = fnam ' Field Name BdcTable.Value(j, "FVAL") = fval ' Field Value Debug.Print BdcTable.Value(j, "FVAL") End Sub
Public Sub rfc_call_transaction() Dim Functions As Object Dim RfcCallTransaction As Object Dim Messages As Object Dim BdcTable As Object ' Create the Function control (that is, the high-level Functions collection): Set Functions = CreateObject("SAP.Functions") ' Set the rest of Connection object values: Functions.Connection.System = "QA[Quality Assurance]" Functions.Connection.client = "100" Functions.Connection.user = "User1" Functions.Connection.password = "" Functions.Connection.language = "EN" If Functions.Connection.Logon(0, False) <> True Then Exit Sub End If Dim iBOB As Integer Do ' Retrieve the Function object (the Connection object must be set up before Function objects can be created): Set RfcCallTransaction = Functions.Add("RFC_CALL_TRANSACTION")
' Set the export parameters RfcCallTransaction.exports("TRANCODE") = "ME32K" RfcCallTransaction.exports("UPDMODE") = "S" Set BdcTable = RfcCallTransaction.Tables("BDCTABLE")
' Set the tables parameter and add the data for the call transaction add_bdcdata BdcTable, "SAPMM06E", "205", "X", "", "" add_bdcdata BdcTable, "", "", "", "BDC_CURSOR", "RM06E-EVRTN" add_bdcdata BdcTable, "", "", "", "BDC_OKCODE", "=KOPF" add_bdcdata BdcTable, "", "", "", "RM06E-EVRTN", ActiveCell.Offset(iBOB, 0).Value add_bdcdata BdcTable, "SAPMM06E", "201", "X", "", "" add_bdcdata BdcTable, "", "", "", "BDC_CURSOR", "EKKO-KTWRT" add_bdcdata BdcTable, "", "", "", "BDC_OKCODE", "=BU" add_bdcdata BdcTable, "", "", "", "EKKO-EKGRP", ActiveCell.Offset(iBOB, 1).Value add_bdcdata BdcTable, "", "", "", "EKKO-PINCR", "10" add_bdcdata BdcTable, "", "", "", "EKKO-UPINC", "1" add_bdcdata BdcTable, "", "", "", "EKKO-KDATB", ActiveCell.Offset(iBOB, 2).Value add_bdcdata BdcTable, "", "", "", "EKKO-KDATE", ActiveCell.Offset(iBOB, 3).Value add_bdcdata BdcTable, "", "", "", "EKKO-ZTERM", ActiveCell.Offset(iBOB, 4).Value add_bdcdata BdcTable, "", "", "", "EKKO-KTWRT", ActiveCell.Offset(iBOB, 5).Value add_bdcdata BdcTable, "", "", "", "EKKO-ZBD1T", "30" add_bdcdata BdcTable, "", "", "", "EKKO-WKURS", "1.00000" add_bdcdata BdcTable, "", "", "", "EKKO-INCO1", "DES" add_bdcdata BdcTable, "", "", "", "EKKO-INCO2", "SAN DIEG0 CA" add_bdcdata BdcTable, "", "", "", "EKKO-TELF1", ActiveCell.Offset(iBOB, 6).Value add_bdcdata BdcTable, "", "", "", "EKKO-LIFRE", ActiveCell.Offset(iBOB, 7).Value 'End SubCall the function (if the result is false, then display a message): If RfcCallTransaction.Call = True Then Set Messages = RfcCallTransaction.imports("MESSG") MsgBox Messages.Value("MSGTX") Else MsgBox " Call Failed! error: " + GetCustomers.Exception End If iBOB = iBOB + 1 Loop Until IsEmpty(ActiveCell.Offset(iBOB, 0))
Functions.Connection.Logoff End Sub ----------------------------------------- Thank you GuestUser
|
By friedmi - 7/13/2010
I think you have to renew connection to system after ech line .Place following line after "Do" command function.connection.copy Following my solution for RFC_CALL TRANSACTION: Dim FunctionCtrl As Object Dim MatNr As String, Werk As String, DispoMerk As String, Disponent As String Dim SapConnection As Object Dim func1 As Object Dim tbloptions As Object Dim BDCTable As Object Dim MsgStruc As Object Set FunctionCtrl = CreateObject("SAP.Functions") Set SapConnection = FunctionCtrl.Connection If Not SapConnection.Logon(0, False) Then MsgBox "Logon failed !!" Exit Sub End If Worksheets("Datenmaske").Range("A2:A64435").ClearContents For x = 2 To Cells(Worksheets("Datenmaske").Rows.Count, 2).End(xlUp).Row MatNr = Worksheets("Datenmaske").Range("B" & x).Value Werk = Worksheets("Datenmaske").Range("C" & x).Value DispoMerk = Worksheets("Datenmaske").Range("E" & x).Value Disponent = Worksheets("Datenmaske").Range("F" & x).Value SapConnection.Copy Set FunctionCtrl = CreateObject("SAP.Functions") Set func1 = FunctionCtrl.Add("RFC_CALL_TRANSACTION") func1.exports("TRANCODE") = "MM02" func1.exports("UPDMODE") = "A" Set BDCTable = func1.tables("BDCTABLE") ......... If Not func1.Call Then MsgBox "Fehler beim Aufrufen von RFC_CALL_TRANSACTION" Exit Sub Else If func1.exception <> "" Then MsgBox "Exception " & func1.exception & " aufgetreten" Else 'Der Aufruf war erfolgreich, wir geben die SAP-Meldung aus: Set MsgStruc = func1.imports("MESSG") Worksheets("Datenmaske").Range("A" & x).Value = MsgStruc("MSGTY") & " / " & MsgStruc("MSGID") & " / " & MsgStruc("MSGNO") & " / " & MsgStruc("MSGTX") 'MsgBox MsgStruc("MSGTY") & " / " & MsgStruc("MSGID") & " / " & MsgStruc("MSGNO") & " / " & MsgStruc("MSGTX") End If End If Next x End Sub
|
|