Skip to content

Instantly share code, notes, and snippets.

@sio
Created October 15, 2019 11:55
Show Gist options
  • Save sio/9a67d9776a6f3792d558c709ee0eeece to your computer and use it in GitHub Desktop.
Save sio/9a67d9776a6f3792d558c709ee0eeece to your computer and use it in GitHub Desktop.
SAP GUI Scripting Sample
Attribute VB_Name = "SapScripting"
Option Explicit
Public Function SAP_GetSession(sName As String) As Object
'
' Get existing SAP session by system name
'
Dim SapApplication As Object
Dim SapGuiAuto As Object
Dim SapConnection As Object
Dim SapSession As Object
Dim i As Integer
' Initialize SAP GUI Scripting API
On Error Resume Next
Set SapGuiAuto = GetObject("SAPGUI")
On Error GoTo 0
If Not SapGuiAuto Is Nothing Then
Set SapApplication = SapGuiAuto.GetScriptingEngine
End If
' Connect to the system
If Not SapApplication Is Nothing Then
If SapApplication.Children.Length > 0 Then
For i = 0 To SapApplication.Children.Length - 1
Set SapConnection = SapApplication.Children(i + 0) '(i+0) is SAP magic
If SapConnection.Description = sName Then
Exit For 'select the first session with correct name
Else
Set SapConnection = Nothing
End If
Next i
End If
End If
' Get the GuiSession object
If Not SapConnection Is Nothing Then
For i = SapConnection.Children.Length - 1 To 0 Step -1
If Not SapConnection.Children(i + 0).Busy _
Or i = 0 Then
Set SapSession = SapConnection.Children(i + 0)
Do While SapSession.Info.Program <> "SAPLSMTR_NAVIGATION" _
And SapSession.Info.Transaction <> "SMEN"
SapSession.EndTransaction
If SapSession.Info.Transaction = "S000" _
Or SapSession.Info.Program = "SAPMSYST" Then
'handle login page
Set SapSession = Nothing
Exit Do
End If
Loop
Exit For
End If
Next i
End If
Set SAP_GetSession = SapSession
If SAP_GetSession Is Nothing Then
MsgBox "Невозможно подключиться к """ & sName & """" & vbNewLine _
& vbNewLine & "Проверьте, выполнен ли вход в систему.", _
Buttons:=vbCritical, Title:="Ошибка"
End If
End Function
Attribute VB_Name = "Sap4T"
Option Explicit
Public Function v4T_export(Optional ByRef oSession As Object = Nothing, _
Optional ByVal sDir As String = "", _
Optional ByVal sPeriod As String = "", _
Optional ByVal bShort As Boolean = False, _
Optional ByVal bLong As Boolean = False, _
Optional ByVal bSh As Boolean = False, _
Optional ByVal bShCh As Boolean = False)
'
'Export 1-K(DR) reports
'
Dim arOptions
Dim bCumulative
Dim i
Dim arRP
Dim bInteractive As Boolean
Dim fInput As f_Sap1KDR
arRP = Array("QL49", "QL51", "QL52", "QL53", "QL75", _
"QL59", "QL65", "QL66", "QL67", "QL74", _
"QL54", "QL56", "QL57", "QL61", "QL62", _
"QL64", "QL68", "QL69", "QL73", "QL76", _
"QL70", "QL72", "QL58", "QL60")
If oSession Is Nothing Then
Set oSession = SAP_GetSession("003. ЕК АСУТР")
End If
bInteractive = (sDir = "") Or _
(sPeriod = "") Or _
Not (bShort Or bLong) Or _
Not (bSh Or bShCh)
If Not oSession Is Nothing Then
If bInteractive Then
Set fInput = New f_Sap1KDR
fInput.Report = "4-Т"
fInput.Show 'get user input via the form
On Error Resume Next
Err.Clear
If Not fInput.Valid Then Exit Function
If Not Err.Number = 0 Then Exit Function
On Error GoTo 0
sDir = fInput.Directory
sPeriod = fInput.Year & "." & fInput.Month
bShort = fInput.ShortPeriod
bLong = fInput.LongPeriod
bSh = fInput.Sh
bShCh = fInput.ShCh
Unload fInput
End If
If Right(sDir, 1) <> Application.PathSeparator Then
sDir = sDir & Application.PathSeparator
End If
If Len(sDir) > 128 - (9 + 6 + 4) Then '128: SAP limit; 9+6+4: filename
MsgBox "Слишком длинный путь к файлу", vbCritical + vbOKOnly, "Ошибка"
Exit Function
End If
If CInt(Right(sPeriod, 2)) = 1 Then
bShort = True
bLong = False
End If
If bShort And bLong Then
arOptions = Array(True, False)
ElseIf bShort Then
arOptions = Array(False)
ElseIf bLong Then
arOptions = Array(True)
Else
Exit Function
End If
If Not bSh And Not bShCh Then Exit Function
'Worker
For Each bCumulative In arOptions
If bSh Then
Call v4T_run(oSession, sDir, sPeriod, arRP, CBool(bCumulative))
End If
If bShCh Then
For Each i In arRP
Call v4T_run(oSession, sDir, sPeriod, Array(i), CBool(bCumulative))
Next i
End If
Next bCumulative
End If
End Function
Private Function v4T_run(ByRef oSession As Object, _
ByVal sDir As String, _
ByVal sPeriod As String, _
ByVal arRP As Variant, _
Optional ByVal bLongPeriod As Boolean = False)
'
'1-К(ДР)
'
Const sFilename As String = "4-Т"
Const sTransaction As String = "Y_DHR_72000024"
Const sBE As String = "5067"
Dim sStartDate As String
Dim i
Dim num As Integer
Dim sPrefix As String
Dim sName As String
Dim sNewFilename As String
Dim sFullPath As String
Dim sTmp
Dim ErrNum(1 To 3) As Long
Dim sOEsingle As String
Dim bSingle(2 To 3) As Boolean
'workaround for "Waiting for OLE" interrupting message
Dim bAlerts As Boolean
bAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
oSession.LockSessionUI
oSession.StartTransaction (sTransaction)
With oSession.findById("wnd[0]")
'initial parameters
If bLongPeriod Then
sStartDate = MonthFirstDay(Left(sPeriod, 5) & "01")
sPrefix = "нар"
Else
sStartDate = MonthFirstDay(sPeriod)
sPrefix = ""
End If
.findById("usr/radPNPTIMR6").Select
.findById("usr/ctxtPNPBEGDA").Text = sStartDate
.findById("usr/ctxtPNPENDDA").Text = MonthLastDay(sPeriod)
.findById("usr/chkSHOW_NPF").Selected = True
.findById("usr/chkSPLT_VAC").Selected = True
.findById("usr/chkSPLT_N70").Selected = True
.findById("usr/chk97_ACCNT").Selected = True
.findById("usr/ctxtPNPBUKRS-LOW").Text = sBE
On Error Resume Next
sOEsingle = CStr(arRP) 'test for string
ErrNum(1) = Err.Number
Err.Clear
bSingle(2) = UBound(arRP) = LBound(arRP) 'test for array
ErrNum(2) = Err.Number
Err.Clear
bSingle(3) = arRP.Count = 1 'test for collection
ErrNum(3) = Err.Number
Err.Clear
On Error GoTo 0
If ErrNum(1) = 0 Then 'type 8204 is a result of array function
.findById("usr/ctxtPNPWERKS-LOW").Text = sOEsingle
ElseIf ErrNum(2) = 0 And bSingle(2) Then
.findById("usr/ctxtPNPWERKS-LOW").Text = arRP(UBound(arRP))
ElseIf ErrNum(3) = 0 And bSingle(3) Then
.findById("usr/ctxtPNPWERKS-LOW").Text = arRP.Item(1)
Else
.findById("usr/ctxtPNPWERKS-LOW").SetFocus
Call ArrayToClipboard(arRP)
.findById("usr/btn%_PNPWERKS_%_APP_%-VALU_PUSH").press
oSession.findById("wnd[1]/tbar[0]/btn[24]").press
.SendVKey 8
End If
.SendVKey 8 'execute (F8)
.SendVKey 0 'enter
End With
num = 0
If UBound(arRP) = LBound(arRP) Then
sName = arRP(LBound(arRP))
Else
sName = CStr(UBound(arRP) - LBound(arRP) + 1) & "дист"
End If
sNewFilename = sPeriod & sPrefix & " " & sName & " " & sFilename
'Export to plain text
With oSession.findById("wnd[0]")
.findById("mbar/menu[0]/menu[1]/menu[2]").Select 'export to the text file
End With
With oSession.findById("wnd[1]")
.findById("usr/sub:SAPLSPO5:0101/radSPOPLI-SELFLAG[0,0]").Select
.findById("tbar[0]/btn[0]").press
End With
With oSession.findById("wnd[1]")
.findById("usr/ctxtDY_PATH").Text = sDir
.findById("usr/ctxtDY_FILENAME").Text = "t" & sNewFilename & ".txt"
.findById("tbar[0]/btn[11]").press
End With
'Export to excel (max full path length is 128 characters)
With oSession.findById("wnd[0]")
.findById("mbar/menu[0]/menu[1]/menu[2]").Select 'export
End With
With oSession.findById("wnd[1]")
.findById("usr/sub:SAPLSPO5:0101/radSPOPLI-SELFLAG[4,0]").Select
.findById("tbar[0]/btn[0]").press
End With
With oSession.findById("wnd[1]")
.findById("usr/chkSCR-EXEC").Selected = False
sTmp = CStr(sDir & _
"" & sNewFilename & ".xls")
If Len(sTmp) <= 128 Then
sFullPath = sTmp
Else
sFullPath = sDir & Application.PathSeparator & _
sPeriod & Left(sPrefix, 1) & " " & sName & ".xls"
If Len(sFullPath) > 128 Then
Err.Raise 5201, , "Слишком длинный путь к файлу:" & vbNewLine & sFullPath
Exit Function
End If
End If
.findById("usr/ctxtSCR-FNAME").Text = sFullPath
.findById("tbar[0]/btn[0]").press
.SendVKey 0 'enter
.SendVKey 0 'enter
End With
'clean up
Application.DisplayAlerts = bAlerts
oSession.UnlockSessionUI
End Function
Public Sub v4T_BatchExport()
'
'One-time batch export. Lots of hardcoded constants!
'
Dim m, n
Dim sP, sD
Const sDestination As String = "D:\Выгрузки из программы\4-Т\"
For m = 2012 To 2014
For n = 1 To 12
If Not (m = 2012 And n < 10) Then
sP = m & "." & Format(n, "00")
sD = sDestination & sP & " закрытый\"
Call v4T_export(sDir:=sD, _
sPeriod:=sP, _
bShort:=True, _
bLong:=True, _
bSh:=True, _
bShCh:=True)
End If
Next n
Next m
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment