VBA - SAP GUI Upload

[jamesmev]

I am running the below code.
The upload is running 1 row at a time.
I want to increase this to 3 lines at a time.
Any Help is appreciated.


Sub eccPBPUpload()

Dim App, Connection, session As Object
Set SapGuiAuto = GetObject("SAPGUI")
Set App = SapGuiAuto.GetScriptingEngine
Set Connection = App.Children(0)
Set session = Connection.Children(0)

UName = Environ("username")
Dim CurrDatTim As Date

Dim excelApp As Object
Set excelApp = GetObject(, "Excel.Application")
excelApp.Visible = True
excelApp.Workbooks("Upload Workbook.xlsm").Activate
excelApp.Worksheets("Primary").Select
excelApp.Range("A1").Activate

Dim row As Long 'Excel Workbook Row
Dim row1 As Integer 'SAP Fast Entry Row
Set tbl = excelApp.ActiveCell.CurrentRegion

myValue = InputBox("What is the starting line?", "Starting Line", "4")

With session
If Left(session.ActiveWindow.Text, 15) <> "SAP Easy Access" Then
If session.ActiveWindow.Text = "Download file" Then
.findById("wnd[1]/tbar[0]/btn[3]").press
.findById("wnd[0]").sendVKey 12 'Sends Window to main screen
Else
.findById("wnd[0]").sendVKey 12 'Sends Window to main screen
End If
End If

.findById("wnd[0]/tbar[0]/okcd").Text = "vk11"
.findById("wnd[0]/tbar[0]/btn[0]").press
.findById("wnd[0]/usr/ctxtRV13A-KSCHL").Text = "ABS"
.findById("wnd[0]/tbar[1]/btn[17]").press
.findById("wnd[1]/usr/sub:SAPLV14A:0100/radRV130-SELKZ[9,0]").Select
.findById("wnd[1]/tbar[0]/btn[0]").press
End With

For row = myValue To tbl.Rows.Count
row1 = 0
ReStrt:
Cust = tbl.Cells(row, 3).Value

With session
.findById("wnd[0]/usr/ctxtKOMG-VKORG").Text = tbl.Cells(row, 2).Value 'Sales
.findById("wnd[0]/usr/ctxtKOMG-VTWEG").Text = "Z1" 'tbl.Cells(row, 2).Value 'Distribution
.findById("wnd[0]/usr/ctxtKOMG-/SCL/PRI_GROUP").Text = tbl.Cells(row, 3).Value 'Group
.findById("wnd[0]/usr/tblSAPMV13ATCTRL_FAST_ENTRY/ctxtKOMG-/SCL/BRAND[0," & row1 & "]").Text = tbl.Cells(row, 4).Value 'Value1
.findById("wnd[0]/usr/tblSAPMV13ATCTRL_FAST_ENTRY/ctxtKOMG-/SCL/PKG[1," & row1 & "]").Text = tbl.Cells(row, 5).Value 'value2
.findById("wnd[0]/usr/tblSAPMV13ATCTRL_FAST_ENTRY/txtKONP-KBETR[5," & row1 & "]").Text = tbl.Cells(row, 6).Value 'Value3
.findById("wnd[0]/usr/tblSAPMV13ATCTRL_FAST_ENTRY/ctxtKONP-KMEIN[8," & row1 & "]").Text = tbl.Cells(row, 7).Value 'value4
.findById("wnd[0]/usr/tblSAPMV13ATCTRL_FAST_ENTRY/ctxtRV13A-DATAB[11," & row1 & "]").Text = tbl.Cells(row, 8).Text 'Start Date
.findById("wnd[0]/usr/tblSAPMV13ATCTRL_FAST_ENTRY/ctxtRV13A-DATBI[12," & row1 & "]").Text = tbl.Cells(row, 9).Text 'End Date

.findById("wnd[0]/tbar[0]/btn[11]").press

If session.ActiveWindow.Text = "Errors as a Result of Overlapping Validity Periods" Then

If SkipApplyToAll > 5 Then 'Used to auto apply skip line
.findById("wnd[1]/tbar[0]/btn[14]").press
Status = "Record Skipped"
GoTo EnterNote
End If

If OverwriteApplyToAll > 5 Then 'Used to auto apply Overwrite line
.findById("wnd[1]/tbar[0]/btn[5]").press
Status = "Record Overwritten"
GoTo EnterNote
End If

Dim intResponse As Integer
intResponse = MsgBox("There was an Error as a Result of Overlapping Validity Periods. Do you want to overwrite the previous entry?", vbYesNo + vbQuestion, "Pricing Entry Overlap")

If intResponse = vbNo Then
.findById("wnd[1]/tbar[0]/btn[14]").press
SkipApplyToAll = SkipApplyToAll + 1
Status = "Record Skipped"
GoTo EnterNote
End If
If intResponse = vbYes Then
.findById("wnd[1]/tbar[0]/btn[5]").press
OverwriteApplyToAll = OverwriteApplyToAll + 1
Sts = "Overrided Previous Entry "
GoTo EnterNote
End If
End If

ApplyToAll:
If session.findById("wnd[0]/sbar").Text <> "" Then
Status = .findById("wnd[0]/sbar").Text
Sts = ""
End If

EnterNote:
End With

CurrDatTim = Now ' Current date and time.
tbl.Cells(row, 10).Value = Sts & Status & " " & UName & " " & CurrDatTim

Next

'Application.Run "'ECC Upload Workbook.xlsm'!ADOFromExcelToAccessPBP"
MsgBox "Process complete.", vbOKOnly + vbInformation
Windows("ECC Upload Workbook.xlsm").Activate
Worksheets("Upload").Select

End Sub