VBA for SAP

VBA for SAP

Get ID & Text of each control in SAP window

Sub Get_SAP_TableIDs()

    Dim SapGuiAuto As Object
    Dim SAPApp As Object
    Dim SAPCon As Object
    Dim session As Object
    Dim ctrl As Object    

    ' define objects
    Set SapGuiAuto = GetObject("SAPGUI")
    Set SAPApp = SapGuiAuto.GetScriptingEngine
    Set SAPCon = SAPApp.Children(0)
    Set session = SAPCon.Children(0)    

    ' Search all the controls on SAP screen
    For Each ctrl In session.FindById("wnd[0]/usr").Children
        Debug.Print ctrl.ID
        Debug.Print ctrl.Text
'        If InStr(1, ctrl.ID, "tbl") > 0 Or InStr(1, ctrl.ID, "shell") > 0 Then
'            Debug.Print "Possible Table/Grid ID: " & ctrl.ID & " | Type: " & ctrl.Type
'        End If
    Next ctrl

    MsgBox "Check Immediate Window (Ctrl+G) for result"

End Sub


Other VBA codes for SAP

'new window
session.findById("wnd[0]/tbar[0]/okcd").Text = "/n"

'enter T-code
session.findById("wnd[0]/tbar[0]/okcd").Text = "su3"

'press enter key
session.findById("wnd[0]").sendVKey 0

'Click on Generate/Replace file button
If Len(Dir(OutputPathSAP & Application.PathSeparator & "Closing balance" & ".xlsx")) = 0 Then
    session.findById("wnd[1]/tbar[0]/btn[0]").Press
Else
    session.findById("wnd[1]/tbar[0]/btn[11]").Press
End If

'Code to By-pass Information windows
Do While session.ActiveWindow.Text Like "*Information"
    session.findById("wnd[1]/tbar[0]/btn[0]").press
Loop

'close pop up if title is Information
If UCase(Session.ActiveWindow.text) = UCase("Information") Then
    Session.findById("wnd[1]/tbar[0]/btn[0]").press
    'Session.findById("wnd[1]/tbar[0]/btn[12]").press
End If

'save SAP screenshot to folder
session.findById("wnd[0]").HardCopy ThisWorkbook.Path & "\Dump\" & POLINE_NUMBER & "\Images\Sapshot_" & M + 1, 1



Get SAP date format

Sub SAP_Connect()
    Dim SapGuiAuto As Object
    
Dim connection As Object
    
Dim FSO As New FileSystemObject
    With ThisWorkbook
        .Activate
        With .Sheets("Mapping")
            .Activate
            LastRow = .Cells(.Rows.Count, 8).End(xlUp).Row
            If LastRow = 1 Then
            Else
                .Range("H2:H" & LastRow).Copy
                If SapGuiAuto Is Nothing Then
                    On Error Resume Next
                    
Set SapGuiAuto = GetObject("SAPGUI")
                    Set app = SapGuiAuto.GetScriptingEngine
                    On Error GoTo 0
                End If
                
If SapGuiAuto Is Nothing Then
                    MsgBox "SAP is not Running", vbCritical, "Please Check"
                    End
                End If

                
If connection Is Nothing Then
                    
On Error Resume Next
                    Set connection = app.Children(0): Set session = connection.Children(0)
                    On Error GoTo 0
                End If
                
If connection Is Nothing Then
                Else
Set connection = app.Children(0): Set session = connection.Children(0)
                End If
                
If connection Is Nothing Then
                    MsgBox "SAP Session is not Running", vbCritical, "Please Check"
                    End
                Else: Set connection = app.Children(0): Set session = connection.Children(0)
                End If
                'storing the date SAP date format
                session.findById("wnd[0]/tbar[0]/okcd").text = "/n"
                session.findById("wnd[0]").sendVKey 0
                session.findById("wnd[0]").maximize
                session.findById("wnd[0]/tbar[0]/okcd").text = "su3"
                session.findById("wnd[0]").sendVKey 0
                session.findById("wnd[0]/usr/tabsTABSTRIP1/tabpDEFA").Select
                TempDateFormat = session.findById("wnd[0]/usr/tabsTABSTRIP1/tabpDEFA/ssubMAINAREA:SAPLSUID_MAINTENANCE:1105/cmbSUID_ST_NODE_DEFAULTS-DATFM").text
                session.findById("wnd[0]/tbar[0]/okcd").text = "/n"
                session.findById("wnd[0]").sendVKey 0

                SapDateFormat = Trim(TempDateFormat)
                If UBound(Split(SapDateFormat, " ")) - LBound(Split(SapDateFormat, " ")) + 1 >= 2 Then
                    SapDateFormat = Split(SapDateFormat, " ")(1)
                End If
                sdate = Format(AsOnDate, SapDateFormat)  'date for tcodes
                tdate = Format(ThisWorkbook.Sheets(Sheet2.Name).Range("C16"), SapDateFormat)  'date for job scheduling
                STime = Format(ThisWorkbook.Sheets(Sheet2.Name).Range("C17"), "hh:mm:ss")

                session.findById("wnd[0]/tbar[0]/okcd").text = "/n"
                session.findById("wnd[0]").sendVKey 0
                session.findById("wnd[0]/tbar[0]/okcd").text = "FBL3N"
                
End Sub


Close Excel instances of SAP

Call CloseSAPExcel("F01.xlsx")

#If VBA7 Then
  Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtrByVal dwId As Long, riid As Any, ppvObject As Object) As Long
  Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As LongPtrByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As StringByVal lpszWindow As StringAs LongPtr
#Else
  Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
  Private Declare Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As Long

#End If


Sub CloseSAPExcel(ParamArray FileNames())
    'Procedure to close files which is downloaded from SAP and at the same time close the Excel application instance that will be open with them.
    Dim ExcelAppSAP As Variant
    Dim ExcelFile As Variant
    Dim FinishedLoop As Boolean, TimeoutReached As Boolean, FileClosed As Boolean
    Dim ReTry As Long
    Dim i As Long, x As Long
    
    Set ExcelAppSAP = Nothing
    ReTry = 100000 'Used as Timeout 100000 = ~10 seconds
    i = 1
    
    'The following loop is executed until excel file is closed.
    'Inside of this, there is a For Loop for each Excel Instance and inside of that is another loop
    'for each excel inside the instance. If name matches, it is closed.

    Do While Not FinishedLoop
        If i > ReTry Then
            TimeoutReached = True
            Exit Do
        End If

        
        For Each ExcelFile In GetXlsInstances() 'Function to Get Excel Open Instances
            For Each xls In ExcelFile.Workbooks
                For x = LBound(FileNames()) To UBound(FileNames())
                    If xls.Name = FileNames(x) Then
                    
                        Set ExcelAppSAP = ExcelFile 'Set Instance opened by SAP to variable
                        'Here add actions if needed. Reference to workbook as xls e.g.: xls.Sheets(1).Range("A1").Copy
                        xls.Close SaveChanges:=False
                        FileClosed = True
                    
                    End If
                Next
x
            Next
        Next
        
        If FileClosed Then
            FinishedLoop = True
        End If
        i = i + 1
    Loop
    
    ThisWorkbook.Activate
    If Not TimeoutReached Then
        If FileClosed Then
            On Error Resume Next
            If ExcelAppSAP.Workbooks.Count = 0 Then
                ExcelAppSAP.Quit
            End If
        Else

            MsgBox "Excel application instance from SAP was not closed correctly. Please close it manually or try again.", , "Error"
        End If
    Else

        MsgBox "Max timeout reached", , "Error"
    End If
End Sub


Public Function GetXlsInstances() As Collection

  Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
  guid(0) = &H20400
  guid(1) = &H0
  guid(2) = &HC0
  guid(3) = &H46000000
  Set GetExcelInstances = New Collection
  Do
    hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
    If hwnd = 0 Then Exit Do
    hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
    hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
    If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
      GetExcelInstances.Add acc.Application
    End If
  Loop
End Function

एक टिप्पणी भेजें

0 टिप्पणियाँ