SAP GUI Scripting 10 - Reading GridView Control

' SAP GUI Scripting Exercise
' This file is provided as is. Please use and modify it for your own use.
' Check out my playlist of SAP GUI Scripting related videos:
' https://www.youtube.com/watch?v=oPPhA14Pm-8&list=PLk9erb9HGsPh28DftWcP8BIXmBtu2wnsL
'
' This document uses transaction OAER to download documents attached to ERP documents. This example was created with sales order
' but could be adapted to use any document  type. This script works for documents that can be downloaded in Business Document Navigator
'
'
' Cheers, Csongor

Public SapGuiAuto, WScript, msgcol
Public objGui  As GuiApplication
Public objConn As GuiConnection
Public objSess As GuiSession
Public objSBar As GuiStatusbar
Public objSheet As Worksheet
Dim W_System
Private LogCount As Integer
Public shScript, shLog As Worksheet



Function Attach_Session() As Boolean
Dim il, it
Dim W_conn, W_Sess

If W_System = "" Then
   Attach_Session = False
   Exit Function
End If

If Not objSess Is Nothing Then
    If objSess.Info.SystemName & objSess.Info.Client = W_System Then
        Attach_Session = True
        Exit Function
    End If
End If

If objGui Is Nothing Then
   Set SapGuiAuto = GetObject("SAPGUI")
   Set objGui = SapGuiAuto.GetScriptingEngine
End If

For il = 0 To objGui.Children.Count - 1
    Set W_conn = objGui.Children(il + 0)
    For it = 0 To W_conn.Children.Count - 1
        Set W_Sess = W_conn.Children(it + 0)
        If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System Then
            Set objConn = objGui.Children(il + 0)
            Set objSess = objConn.Children(it + 0)
            Exit For
        End If
    Next
Next

If objSess Is Nothing Then
   MsgBox "No active session to system " + W_System + ", or scripting is not enabled.", vbCritical + vbOKOnly
   Attach_Session = False
   Exit Function
End If

If IsObject(WScript) Then
   WScript.ConnectObject objSess, "on"
   WScript.ConnectObject objGui, "on"
End If

Set objSBar = objSess.findById("wnd[0]/sbar")
objSess.findById("wnd[0]").maximize
Attach_Session = True


End Function

Public Sub RunGUIScript(currentline As Integer)

Dim W_Ret As Boolean
Dim GridView As Object

W_Ret = Attach_Session
If Not W_Ret Then
    Exit Sub
End If



'On Error GoTo myerr

objSess.findById("wnd[0]").maximize
objSess.findById("wnd[0]/tbar[0]/okcd").Text = "/nSE16"
objSess.findById("wnd[0]").sendVKey 0
objSess.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").Text = "USR02"
objSess.findById("wnd[0]/usr/ctxtDATABROWSE-TABLENAME").caretPosition = 5
objSess.findById("wnd[0]").sendVKey 0
objSess.findById("wnd[0]/usr/txtI10-LOW").Text = "DL_YXMENG"
objSess.findById("wnd[0]/usr/txtMAX_SEL").Text = ""
objSess.findById("wnd[0]/usr/txtMAX_SEL").SetFocus
objSess.findById("wnd[0]/usr/txtMAX_SEL").caretPosition = 11
objSess.findById("wnd[0]/tbar[1]/btn[8]").Press

' Save the gridview control as a local object
'Set GridView = objSess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[0]/shell")
Set GridView = objSess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell")

'Get the column list from the view and update the titles in Row 9
For i = 0 To GridView.ColumnCount - 1
    Cells(9, i + 1) = GridView.GetColumnTitles(GridView.ColumnOrder(i))(0)
Next i

' Extract all the cell contents the the SAP control and put it into the Excel from row 10
For i = 0 To GridView.RowCount - 1
    For j = 0 To GridView.ColumnCount - 1
        Cells(10 + i, j + 1) = GridView.GetCellValue(i, GridView.ColumnOrder(j))
    Next j
Next i


' Setting the line status to completed
Exit Sub

myerr:
    MsgBox Err.Number & ":" & Err.Description

End Sub


Function FolderCreate(ByVal path As String) As Boolean

FolderCreate = True
Set fso = CreateObject("Scripting.FileSystemObject")

If FolderExists(path) Then
    Exit Function
Else
    On Error GoTo DeadInTheWater
    fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
    Exit Function
End If

DeadInTheWater:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function

End Function

Function FolderExists(ByVal path As String) As Boolean

FolderExists = False
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(path) Then FolderExists = True

End Function



Sub StartExtract()
Dim currentline As Integer

    'Se the defaults
    W_System = Range("System").Value
    Set shScript = Worksheets("Script")
    ResetLog

    RunGUIScript 10

    ' Update the current date and time
    Cells(2, 2).Value = Now()
    objSess.EndTransaction
    MsgBox "Script completed"

End Sub

Sub ResetLog()
    'This function deleted the current log and resets some values

    Dim LastRow As Integer

    Set shLog = Worksheets("Log")
    LogCount = 0
    shLog.Select
    'Find the last row in the sheet
    LastRow = shLog.UsedRange.Rows(shLog.UsedRange.Rows.Count).Row
    If LastRow < 3 Then LastRow = 3
    Rows("3:" + CStr(LastRow)).Select
    Selection.Delete Shift:=xlUp
    Range("A3").Select
    shScript.Select
End Sub

Sub AddLog(id As String, message As String, color As Integer)
    'New line is added to the log
    shLog.Cells(LogCount + 3, 1).Font.color = color
    shLog.Cells(LogCount + 3, 2).Font.color = color
    shLog.Cells(LogCount + 3, 1) = id
    shLog.Cells(LogCount + 3, 2) = message

    'Add borders to the new cells
    shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlDiagonalDown).LineStyle = xlNone
    shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlDiagonalUp).LineStyle = xlNone
    With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With shLog.Range("A" + CStr(LogCount + 3) + ":B" + CStr(LogCount + 3)).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With


    LogCount = LogCount + 1
End Sub