SAP

'funckja, która namierzy pierwszą otwartą transakcję w Sapie, dla bezpieczeństwa dodałem,
'żeby sprawdzał czy jest na stronie startowej - "Sap easy access"
Function createSApConnection()
Set SapGuiAuto = GetObject("SAPGUI")
If SapGuiAuto Is Nothing Then
MsgBox "open SAP", vbCritical
End
End If

Set sapApp = SapGuiAuto.GetScriptingEngine

Set Connection = sapApp.Children(0)

If Connection Is Nothing Then
MsgBox "login to SAP", vbCritical
>End
End If

Set createSApConnection = Connection.Children(0)
If Not UCase(createSApConnection.ActiveWindow.Text) Like UCase("Sap easy access*") Then
MsgBox "Go back to SAP starting page", vbCritical
End
End If
Set SapGuiAuto = Nothing
Set Connection = Nothing

End Function

'funckja inicjująca
Sub pobier()
Dim session As Object
Dim filespath As String

On Error GoTo 0
Set session = createSApConnection

If Not session Is Nothing Then
filespath = createTodaysFOlderonDesktop(CStr(Format(VBA.Date, "dd.mm.yyyy")))

Call getfromSAP(filespathpath, session)
MsgBox "done", vbOKOnly
Else
MsgBox "you should login to sap first"
End If
End Sub

'tworzę folder z nazwą miesiąca i dniem na pulpicie
Public Function createTodaysFOlderonDesktop(day As String)
Dim path As String

path = "C:\users\" & VBA.Environ("username") & "\desktop\" & VBA.MonthName(Month((CDate(Replace(day, ".", "/")))), True) & "\"
If Dir(path, vbDirectory) = "" Then
MkDir path
End If
path = Empty

path = "C:\users\" & VBA.Environ("username") & "\desktop\" & VBA.MonthName(Month((CDate(Replace(day, ".", "/")))), True) & "\" & day & "\"
If Dir(path, vbDirectory) = "" Then
MkDir path
End If
createTodaysFOlderonDesktop = path
path = Empty

End Function

''''po wciśnięciu f8 - generowanie raportu wywołuję save as xxl
''''jak już wcześniej mówiłem – bazą jest nagrany skrypt z SAP
''nagrany vbs edytujemy i przenosimy zgrabnie do excela
session.findById("wnd[0]").sendVKey 8

Call PressDOwnloadASXXl(session, filespath, "nazwapliku.xlsx")

Sub PressDOwnloadASXXl(session As Object, filespath As String, filename As String)

thebeginning:

session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select'export
session.findById("wnd[1]/usr/cmbG_LISTBOX").SetFocus
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "08" 'xxl
session.findById("wnd[1]/tbar[0]/btn[0]").press


session.findById("wnd[1]/tbar[0]/btn[0]").press

session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").Select
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").SetFocus ''table
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press

If saveThisWorkbook(filespath, filename) = False Then ''zapisuję nowootwarty plik
session.findById("wnd[1]/tbar[0]/btn[0]").press
GoTo thebeginning
End If
session.findById("wnd[1]/tbar[0]/btn[0]").press 'powrót

End Sub

Function saveThisWorkbook(foldername As String, filename As String) As Boolean
Dim idmsWB As Workbook

If isWorkbookOpened("Worksheet in Basis (1)") = True Then
Workbooks("Worksheet in Basis (1)").Activate
Else
saveThisWorkbook = False
Exit Function

End If

ActiveWorkbook.SaveAs foldername & filename, 51 '51 = xlsx
saveThisWorkbook = True

End Function

'prosta pętla po otwartych oknach excela, która znajdzie otwarty plik po nazwie
Function isWorkbookOpened(ws As String) As Boolean
Dim w As Workbook
If Application.Workbooks.Count = 0 Then Application.Workbooks.Add

For Each w In Application.Workbooks
If w.Name = ws Then
isWorkbookOpened = True
Exit Function
End If
Next

isWorkbookOpened = False

End Function