RE: I am new to VBA. I am not able to loop the data to process

friedmi — Tue, 13 Jul 2010 05:18:21 GMT

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

I am new to VBA. I am not able to loop the data to process

GuestUser — Tue, 19 Oct 2004 21:57:40 GMT

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

A1VBCode Forums / Classic Visual Basic (VB 6 or earlier) / VBA(Excel, Word, etc...) / I am new to VBA. I am not able to loop the data to process / Latest Posts

RE: I am new to VBA. I am not able to loop the data to process

I am new to VBA. I am not able to loop the data to process