Script SAP from an excel list-CodePudding

I am trying to make an automated report from a list in an Excel sheet.

I have to place several codes in the FBL3N transaction but in a dynamic way. That is, the list can increase or decrease and the macro has to place the codes that exist in column A of the Sheet "Counts"

The following code is edited for security reasons:

If Not IsObject(application) Then
  Set SapGuiAuto  = GetObject("SAPGUI")
  Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
  Set connection = application.Children(0)
End If
If Not IsObject(session) Then
  Set session    = connection.Children(0)
End If
If IsObject(WScript) Then
  WScript.ConnectObject session,     "on"
  WScript.ConnectObject application, "on"
End If

session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "FBL3N"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtSD_BUKRS-LOW").text = "1521"
session.findById("wnd[0]/usr/btn%_SD_SAKNR_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/usr/tabsTAB_STRIP/ctxtRSCSEL_255-SLOW_I[1,0]").text = "1521200002"
session.findById("wnd[1]/usr/tabsTAB_STRIP/ctxtRSCSEL_SLOW_I[1,1]").text = "1521200103"
session.findById("wnd[1]/usr/tabsTAB_STRIP/ctxtRSCSEL_SLOW_I[1,2]").text = "1521200603"
session.findById("wnd[1]/usr/tabsTAB_STRIP/ctxtRSCSEL_SLOW_I[1,3]").text = "1521200803"
session.findById("wnd[1]/usr/tabsTAB_STRIP/ctxtRSCSEL_SLOW_I[1,4]").text = "1521200903"

Maybe I would need a "FOR" that goes through all the cells in column A of my Counts sheet. I hope your help thank you very much

enter image description here

CodePudding user response：

Two ways:

For Next:

Set rngAree = [Aree]
For Each cl In rngAree ' set Aree
    If intPos = 0 Then
        Session.FindById("wnd[0]/usr/ctxtIWERK-LOW").Text = cl.Value
        Session.FindById("wnd[0]/usr/btn%_IWERK_%_APP_%-VALU_PUSH").press
    Else
        Session.FindById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1," & intPos & "]").Text = cl.Value
    End If
    intPos = intPos   1
Next

If the number of values exceeds 8 rows I prefer to .Copy and .Paste with button

Session.FindById("wnd[1]/tbar[0]/btn[24]").press

CodePudding user response：

As in the comments mentioned you put your data into the clipboard. I use the code below for that. Also have look at 1 and 2

Option Explicit

' https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
' https://stackoverflow.com/a/54978696

#If VBA7 Then

Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

#Else

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

#End If

Public Sub SetClipboard(ByVal sUniText As String)

#If VBA7 Then
    Dim iStrPtr As LongPtr
    Dim iLock As LongPtr
#Else
    Dim iStrPtr As Long
    Dim iLock As Long
#End If

    Dim iLen As Long

    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD

    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText)   2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE   GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub


Public Function GetClipboard() As String
#If VBA7 Then
    Dim iStrPtr As LongPtr
    Dim iLock As LongPtr
#Else
    Dim iStrPtr As Long
    Dim iLock As Long
#End If
    Dim iLen As Long
    Dim sUniText As String

    Const CF_UNICODETEXT As Long = 13&

    OpenClipboard 0&

    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If

    CloseClipboard
End Function

The following code will get the data from column A assuming there is no header

Function getColA(ws As Worksheet) As Range
    Dim rng As Range
        
    Dim lastRow As Long
    lastRow = FindLastRow(ws.Columns(1))
    
    With ws
        Set rng = Range(.Cells(1, 1), .Cells(lastRow, 1))
    End With
    Set getColA = rng
End Function
Function FindLastRow(rg As Range) As Long
    
    On Error GoTo EH
    
    FindLastRow = rg.Find("*", , Lookat:=xlPart, LookIn:=xlFormulas _
        , searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Exit Function

EH:
    FindLastRow = rg.Cells(1, 1).Row

End Function

This function will put the data into the clipboard assuming the data is in the active sheet. You have to adjust that accordingly

Function putDataIntoClibboard()
    
    Dim vDat As Variant
    vDat = Application.Transpose(getColA(ActiveSheet).Value)
    vDat = Join(vDat, vbCrLf)

    SetClipboard vDat
    
End Function

Your code would then look like that

session.FindById("wnd[0]").maximize
session.FindById("wnd[0]/tbar[0]/okcd").Text = "FBL3N"
session.FindById("wnd[0]").sendVKey 0
session.FindById("wnd[0]/usr/ctxtSD_BUKRS-LOW").Text = "1521"
session.FindById("wnd[0]/usr/btn%_SD_SAKNR_%_APP_%-VALU_PUSH").Press
putDataIntoClibboard
session.FindById("wnd[1]/tbar[0]/btn[24]").Press