mengyuxin

GUI Scripting 12 - Extract Large Tables

Apr 10th, 2021
1,357
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' SAP GUI Scripting Exercise
  2. ' This file is provided as is. Please use and modify it for your own use.
  3. ' Check out my playlist of SAP GUI Scripting related videos:
  4. ' https://www.youtube.com/watch?v=oPPhA14Pm-8&list=PLk9erb9HGsPh28DftWcP8BIXmBtu2wnsL
  5. '
  6. 'This example shows how to extract data from large tables such as BKPF and mergeing the result into a large list in Excel
  7. '
  8. ' Cheers, Csongor
  9.  
  10. Public SapGuiAuto, WScript, msgcol
  11. Public objGui  As GuiApplication
  12. Public objConn As GuiConnection
  13. Public objSess As GuiSession
  14. Public objSBar As GuiStatusbar
  15. Public objSheet As Worksheet
  16. Dim W_System
  17. Private LogCount As Integer
  18. Public shScript, shLog As Worksheet
  19.  
  20. ' -------------------------------------------------------------------
  21. ' This method cycles through all open GUI sessions and finds the
  22. ' first matching the SID+Client stored in the Excel
  23. ' -------------------------------------------------------------------
  24. Function Attach_Session() As Boolean
  25. Dim il, it
  26. Dim W_conn, W_Sess
  27.  
  28. If W_System = "" Then
  29.    Attach_Session = False
  30.    Exit Function
  31. End If
  32.  
  33. If Not objSess Is Nothing Then
  34.     If objSess.Info.SystemName & objSess.Info.Client = W_System Then
  35.         Attach_Session = True
  36.         Exit Function
  37.     End If
  38. End If
  39.  
  40. If objGui Is Nothing Then
  41.    Set SapGuiAuto = GetObject("SAPGUI")
  42.    Set objGui = SapGuiAuto.GetScriptingEngine
  43. End If
  44.  
  45. For il = 0 To objGui.Children.Count - 1
  46.     Set W_conn = objGui.Children(il + 0)
  47.     For it = 0 To W_conn.Children.Count - 1
  48.         Set W_Sess = W_conn.Children(it + 0)
  49.         If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System Then
  50.             Set objConn = objGui.Children(il + 0)
  51.             Set objSess = objConn.Children(it + 0)
  52.             Exit For
  53.         End If
  54.     Next
  55. Next
  56.  
  57. If objSess Is Nothing Then
  58.    MsgBox "No active session to system " + W_System + ", or scripting is not enabled.", vbCritical + vbOKOnly
  59.    Attach_Session = False
  60.    Exit Function
  61. End If
  62.  
  63. If IsObject(WScript) Then
  64.    WScript.ConnectObject objSess, "on"
  65.    WScript.ConnectObject objGui, "on"
  66. End If
  67.  
  68. Set objSBar = objSess.findById("wnd[0]/sbar")
  69. objSess.findById("wnd[0]").maximize
  70. Attach_Session = True
  71.  
  72.  
  73. End Function
  74.  
  75. ' -----------------------------------------------------------
  76. ' Running the actula GUI script for the active line in the Excel
  77. ' -----------------------------------------------------------
  78. Public Sub RunGUIScript(currentline As Integer)
  79.  
  80. Dim W_Ret As Boolean
  81. Dim Filename As String
  82. Dim Folder As String
  83.  
  84. W_Ret = Attach_Session
  85. If Not W_Ret Then
  86.     Exit Sub
  87. End If
  88.  
  89. ' Filename will be row id, so it will start with export_0010
  90. Filename = "export_" & Right("00000" & currentline, 4) & ".txt"
  91. 'Get the same folder
  92. Folder = Range("Folder").Value
  93.  
  94. On Error GoTo myerr
  95.  
  96. AddLog "Extract", "Extracting file " + Filename, vbBlack
  97. objSess.findById("wnd[0]").maximize
  98. objSess.findById("wnd[0]/tbar[0]/okcd").Text = "/nse16"
  99. objSess.findById("wnd[0]").sendVKey 0
  100. objSess.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").Text = "bkpf"
  101. objSess.findById("wnd[0]").sendVKey 0
  102. objSess.findById("wnd[0]/usr/ctxtI1-LOW").Text = Cells(currentline, 1).Value
  103. objSess.findById("wnd[0]/usr/ctxtI5-LOW").Text = Replace(Cells(currentline, 2).Value, "-", "/")
  104. objSess.findById("wnd[0]/usr/ctxtI5-HIGH").Text = Replace(Cells(currentline, 3).Value, "-", "/")
  105. objSess.findById("wnd[0]/usr/ctxtLIST_BRE").Text = "1250"
  106. objSess.findById("wnd[0]/usr/txtMAX_SEL").Text = "100000"
  107. objSess.findById("wnd[0]/usr/txtMAX_SEL").SetFocus
  108. objSess.findById("wnd[0]/usr/txtMAX_SEL").caretPosition = 10
  109. objSess.findById("wnd[0]").sendVKey 0
  110. objSess.findById("wnd[0]/tbar[1]/btn[8]").press
  111. objSess.findById("wnd[0]/tbar[0]/okcd").Text = "%pc"
  112. objSess.findById("wnd[0]").sendVKey 0
  113. objSess.findById("wnd[1]/tbar[0]/btn[0]").press
  114. objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = Filename
  115. objSess.findById("wnd[1]/usr/ctxtDY_PATH").Text = Folder
  116. objSess.findById("wnd[1]/tbar[0]/btn[11]").press
  117.  
  118. AddLog "Extract", "Extracted " + Filename, vbBlack
  119. ' Setting the line status to completed
  120. Cells(currentline, 4).Value = 1
  121. Exit Sub
  122.  
  123. myerr:
  124. ' Some error occured
  125. ' Setting the line status to Failed
  126. Cells(currentline, 4).Value = 2
  127. AddLog "Extract", "Failed " + Filename, vbRed
  128.  
  129. End Sub
  130.  
  131.  
  132. Function FolderCreate(ByVal path As String) As Boolean
  133.  
  134. FolderCreate = True
  135. Set fso = CreateObject("Scripting.FileSystemObject")
  136.  
  137. If FolderExists(path) Then
  138.     Exit Function
  139. Else
  140.     On Error GoTo DeadInTheWater
  141.     fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
  142.    Exit Function
  143. End If
  144.  
  145. DeadInTheWater:
  146.     MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
  147.     FolderCreate = False
  148.     Exit Function
  149.  
  150. End Function
  151.  
  152. Function FolderExists(ByVal path As String) As Boolean
  153.  
  154. FolderExists = False
  155. Set fso = CreateObject("Scripting.FileSystemObject")
  156.  
  157. If fso.FolderExists(path) Then FolderExists = True
  158.  
  159. End Function
  160.  
  161. ' -------------------------------------------------------------
  162. ' Load the extract generated by SE16 to Excel
  163. ' -------------------------------------------------------------
  164. Function OpenExtract(Filename As String) As Boolean
  165. '
  166. ' Load the SE16 extract
  167. '
  168. '
  169. On Error GoTo myerr
  170.     With ActiveSheet.QueryTables.Add(Connection:= _
  171.         "TEXT;" & Filename, Destination:=Range("$A$1"))
  172.         .Name = "export"
  173.         .FieldNames = True
  174.         .RowNumbers = False
  175.         .FillAdjacentFormulas = False
  176.         .PreserveFormatting = True
  177.         .RefreshOnFileOpen = False
  178.         .RefreshStyle = xlInsertDeleteCells
  179.         .SavePassword = False
  180.         .SaveData = True
  181.         .AdjustColumnWidth = True
  182.         .RefreshPeriod = 0
  183.         .TextFilePromptOnRefresh = False
  184.         .TextFilePlatform = 437
  185.         .TextFileStartRow = 4
  186.         .TextFileParseType = xlDelimited
  187.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
  188.         .TextFileConsecutiveDelimiter = False
  189.         .TextFileTabDelimiter = False
  190.         .TextFileSemicolonDelimiter = False
  191.         .TextFileCommaDelimiter = False
  192.         .TextFileSpaceDelimiter = False
  193.         .TextFileOtherDelimiter = "|"
  194.         .TextFileColumnDataTypes = Array(9, 9, 9, 1, 1, 1, 1, 4, 4, 1, 4, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, _
  195.         1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
  196.         , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
  197.         .TextFileDecimalSeparator = ","
  198.         .TextFileThousandsSeparator = "."
  199.         .TextFileTrailingMinusNumbers = True
  200.         .Refresh BackgroundQuery:=False
  201.     End With
  202.     OpenExtract = True
  203.     Exit Function
  204. myerr:
  205.     OpenExtract = False
  206. End Function
  207.  
  208. ' ---------------------------------------------------------------
  209. ' Copy the loaded extract from the temp sheet and add to the end of the list
  210. ' on the Export sheet
  211. ' ---------------------------------------------------------------
  212. Function CopyOver(currentline As Integer) As Boolean
  213. '
  214. '
  215. Dim tempmax As Long
  216. Dim extractmax As Long
  217. '
  218. On Error GoTo myerr
  219.  
  220.     ' If this is the first line, copy the headers over
  221.    If currentline = 10 Then
  222.         Sheets("temp").Select
  223.         Rows("1:1").Select
  224.         Selection.Copy
  225.         Sheets("Export").Select
  226.         Rows("1:1").Select
  227.         ActiveSheet.Paste
  228.     End If
  229.  
  230.     Sheets("temp").Select
  231.     'Find the last line in the temp sheet
  232.    tempmax = 3
  233.     While Cells(tempmax, 1).Value <> ""
  234.         tempmax = tempmax + 1
  235.     Wend
  236.     tempmax = tempmax - 1
  237.    
  238.     Rows("3:" & tempmax).Select
  239.     Application.CutCopyMode = False
  240.     Selection.Copy
  241.     Sheets("Export").Select
  242.    
  243.     ' Find the last line in the extract sheet
  244.    extractmax = 2
  245.     While Cells(extractmax, 1).Value <> ""
  246.         extractmax = extractmax + 1
  247.     Wend
  248.    
  249.     Rows(extractmax & ":" & extractmax).Select
  250.     ActiveSheet.Paste
  251.  
  252.     CopyOver = True
  253.     Exit Function
  254. myerr:
  255.     CopyOver = False
  256. End Function
  257.  
  258. ' ----------------------------------------------------------------
  259. ' The entire extraction routine which calls the GUI script for each line
  260. ' runs the extract and after loades and summarizes the data into Excel
  261. ' ----------------------------------------------------------------
  262. Sub StartExtract()
  263. Dim currentline As Integer
  264. Dim Filename As String
  265.  
  266.  
  267.     If MsgBox("Make sure you delete any old extracts from folder " & Range("Folder").Value, vbOKCancel, "Delete old data") = vbCancel Then
  268.         Exit Sub
  269.     End If
  270.    
  271.     'Set the defaults
  272.    W_System = Range("System").Value
  273.     Set shScript = Worksheets("Script")
  274.     ResetLog
  275.    
  276.     Sheets("Export").Select
  277.     DeleteAll
  278.     Sheets("Script").Select
  279.    
  280.     ' First create the download all the table entries one-by-one
  281.    currentline = 10
  282.     While Cells(currentline, 1).Value <> ""
  283.         RunGUIScript currentline
  284.         ' move to the next line
  285.        currentline = currentline + 1
  286.     Wend
  287.    
  288.     ' Process all the extracted data
  289.    Application.Calculation = xlCalculateManual
  290.     currentline = 10
  291.     While Cells(currentline, 1).Value <> ""
  292.         Sheets("temp").Select
  293.         DeleteAll
  294.         Filename = Range("Folder").Value + "\export_" & Right("00000" & currentline, 4) & ".txt"
  295.         AddLog "Load", "Loading file " + Filename, vbBlack
  296.         ' Load the extract to the temp sheet
  297.        If OpenExtract(Filename) Then
  298.             AddLog "Load", "Loaded " + Filename, vbBlack
  299.             ' Clean up any columns that are required
  300.            ' Uncomment the next line to trim all cells (for trailing spaces)
  301.            ' Trimall
  302.            ' Use the below line to trim only a selected column
  303.            TrimColumn 20
  304.             If CopyOver(currentline) Then
  305.                 AddLog "Copy", "Copy data over done", vbBlack
  306.             Else
  307.                 AddLog "Copy", "Copy data over failed", vbRed
  308.             End If
  309.         Else
  310.             AddLog "Load", "Failed to load " + Filename, vbRed
  311.         End If
  312.        
  313.         Sheets("Script").Select
  314.         ' move to the next line
  315.        currentline = currentline + 1
  316.     Wend
  317.     Application.Calculation = xlCalculationAutomatic
  318.     ' Update the current date and time
  319.    Sheets("Script").Select
  320.     Cells(2, 2).Value = Now()
  321.     objSess.EndTransaction
  322.     MsgBox "Script completed"
  323.  
  324. End Sub
  325.  
  326. Sub ResetLog()
  327.     'This function deleted the current log and resets some values
  328.    
  329.     Dim LastRow As Integer
  330.    
  331.     Set shLog = Worksheets("Log")
  332.     LogCount = 0
  333.     shLog.Select
  334.     'Find the last row in the sheet
  335.    LastRow = shLog.UsedRange.Rows(shLog.UsedRange.Rows.Count).row
  336.     If LastRow < 3 Then LastRow = 3
  337.     Rows("3:" + CStr(LastRow)).Select
  338.     Selection.Delete Shift:=xlUp
  339.     Range("A3").Select
  340.     shScript.Select
  341. End Sub
  342.  
  343. Sub AddLog(id As String, message As String, color As Integer)
  344.     'New line is added to the log
  345.    shLog.Cells(LogCount + 3, 1).Font.color = color
  346.     shLog.Cells(LogCount + 3, 2).Font.color = color
  347.     shLog.Cells(LogCount + 3, 1) = id
  348.     shLog.Cells(LogCount + 3, 2) = message
  349.    
  350.     'Add borders to the new cells
  351.    shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlDiagonalDown).LineStyle = xlNone
  352.     shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlDiagonalUp).LineStyle = xlNone
  353.     With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeLeft)
  354.         .LineStyle = xlContinuous
  355.         .ColorIndex = 0
  356.         .TintAndShade = 0
  357.         .Weight = xlThin
  358.     End With
  359.     With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeTop)
  360.         .LineStyle = xlContinuous
  361.         .ColorIndex = 0
  362.         .TintAndShade = 0
  363.         .Weight = xlThin
  364.     End With
  365.     With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeBottom)
  366.         .LineStyle = xlContinuous
  367.         .ColorIndex = 0
  368.         .TintAndShade = 0
  369.         .Weight = xlThin
  370.     End With
  371.     With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeRight)
  372.         .LineStyle = xlContinuous
  373.         .ColorIndex = 0
  374.         .TintAndShade = 0
  375.         .Weight = xlThin
  376.     End With
  377.     With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlInsideVertical)
  378.         .LineStyle = xlContinuous
  379.         .ColorIndex = 0
  380.         .TintAndShade = 0
  381.         .Weight = xlThin
  382.     End With
  383.     With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlInsideHorizontal)
  384.         .LineStyle = xlContinuous
  385.         .ColorIndex = 0
  386.         .TintAndShade = 0
  387.         .Weight = xlThin
  388.     End With
  389.    
  390.    
  391.     LogCount = LogCount + 1
  392. End Sub
  393.  
  394. Sub DeleteAll()
  395. '
  396. ' DeleteAll Macro
  397. '
  398.  
  399. '
  400.    On Error Resume Next
  401.     Cells.Select
  402.     Selection.QueryTable.Delete
  403.     Selection.ClearContents
  404.     Range("A1").Select
  405. End Sub
  406.  
  407. Sub TrimAll()
  408. Dim row As Integer
  409. Dim col As Integer
  410.  
  411. row = 3
  412. col = 1
  413.  
  414. On Error Resume Next
  415. While Cells(row, col).Value <> ""
  416.     While Cells(row, col).Value <> ""
  417.         Cells(row, col).Value = Trim(Cells(row, col).Value)
  418.         col = col + 1
  419.     Wend
  420.     row = row + 1
  421.     col = 1
  422. Wend
  423.  
  424. Range("A1").Select
  425. End Sub
  426.  
  427. Sub TrimColumn(col As Integer)
  428. Dim row As Integer
  429.  
  430. row = 3
  431.  
  432. On Error Resume Next
  433. While Cells(row, col).Value <> ""
  434.     Cells(row, col).Value = Trim(Cells(row, col).Value)
  435.     row = row + 1
  436. Wend
  437.  
  438. Range("A1").Select
  439. End Sub
  440.  
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×