sap extract

gistfile1.txt

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
Const fpath = "C:\Users\..."
Const ffilename = "y08.txt"

Sub OpenCSVFile()

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fpath & "\" & ffilename, Destination:=Range("$A$1"))
        .Name = "y08"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
     Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    
   
End Sub

Sub DeleteAll()
    On Error Resume Next
    Cells.Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    Range("A1").Select
End Sub

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 existe sesión " + W_System + " activa en SAP, o el scripting esta deshabilitado.", 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()

Dim W_Ret As Boolean


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 = "mb51"
objSess.findById("wnd[0]").sendVKey 0
objSess.findById("wnd[0]/usr/ctxtBWART-LOW").Text = "Y08"
objSess.findById("wnd[0]/usr/ctxtBWART-LOW").SetFocus
objSess.findById("wnd[0]/usr/ctxtBWART-LOW").caretPosition = 3
objSess.findById("wnd[0]/tbar[1]/btn[8]").press
objSess.findById("wnd[0]/tbar[1]/btn[48]").press
objSess.findById("wnd[0]/mbar/menu[3]/menu[2]/menu[1]").Select
objSess.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").currentCellRow = 13
objSess.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").firstVisibleRow = 3
objSess.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectedRows = "13"
objSess.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").clickCurrentCell
objSess.findById("wnd[0]/mbar/menu[0]/menu[1]/menu[2]").Select
objSess.findById("wnd[1]/tbar[0]/btn[0]").press
objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = ffilename
objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 7
objSess.findById("wnd[1]/tbar[0]/btn[11]").press
objSess.findById("wnd[0]/tbar[0]/btn[15]").press
objSess.findById("wnd[0]/tbar[0]/btn[15]").press
objSess.findById("wnd[0]/tbar[0]/btn[15]").press

Exit Sub

myerr:
   MsgBox "Listo", vbCritical + vbOKOnly
    

End Sub

Sub StartExtract()
    W_System = ".."
    RunGUIScript
    objSess.EndTransaction
    Sheets("Y08").Select
    DeleteAll
    OpenCSVFile
    Sheets("Menu").Select