on 11-06-2013 2:35 PM
Hi Team,
I am new to SAP scripting and i have recorded below SAP Script to download a report from SAP in Excel format at specified format.
Here issue is that i am not able to record the Save as dialogue where the file needs to be saved automatically.
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "/nfbl3n"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/usr/txtENAME-LOW").text = "10290492"
session.findById("wnd[1]/usr/txtENAME-LOW").setFocus
session.findById("wnd[1]/usr/txtENAME-LOW").caretPosition = 8
session.findById("wnd[1]").sendVKey 8
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").currentCellColumn = "TEXT"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
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]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
Can anyone of you help me to provide script for the same so that report is automatically saved in specified path.
Thanks
Hi Dan,
You could also try the following:
. . .
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").select
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
'Here follow the new commands.
SAP_Workbook = "Tabelle von Basis (1)"
EXCEL_Path = "z:\tmp\"
myWorkbook = "myWorkbook.xlsx"
on error resume next
do
err.clear
Set xclApp = GetObject(, "Excel.Application")
If Err.Number = 0 Then exit do
'msgbox "Wait for Excel session"
wscript.sleep 2000
loop
do
err.clear
Set xclwbk = xclApp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then exit do
'msgbox "Wait for SAP workbook"
wscript.sleep 2000
loop
on error goto 0
Set xclSheet = xclwbk.Worksheets(1)
xclApp.Visible = True
xclapp.DisplayAlerts = false
xclapp.ActiveWorkbook.SaveAs EXCEL_Path & myWorkbook
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
'xclapp.Quit
set xclapp = Nothing
You should only modify your own parameters for SAP_Workbook, EXCEL_Path and myWorkbook.
Regards,
ScriptMan
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hi Script Man,
Thanks for the below code but i hope that you got my question that my SAP report which is exported in excel should be automatically saved in specified path.
But I am not able to export the report automatically with the below code which you provided.
Please check and let me know where i am going wrong and also let me know what do you mean by this line code SAP_Workbook = "Tabelle von Basis (1)" and what is that i need to change at my end.
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "/nfbl3n"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/usr/txtENAME-LOW").text = "10490492"
session.findById("wnd[1]/usr/txtENAME-LOW").setFocus
session.findById("wnd[1]/usr/txtENAME-LOW").caretPosition = 8
session.findById("wnd[1]").sendVKey 8
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").currentCellColumn = "TEXT"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
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]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
SAP_Workbook = "Tabelle von Basis (1)"
EXCEL_Path = "C:\SAP\"
myWorkbook = "Report.xlsx"
on error resume next
do
err.clear
Set xclApp = GetObject(, "Excel.Application")
If Err.Number = 0 Then exit do
'msgbox "Wait for Excel session"
wscript.sleep 2000
loop
do
err.clear
Set xclwbk = xclApp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then exit do
'msgbox "Wait for SAP workbook"
wscript.sleep 2000
loop
on error goto 0
Set xclSheet = xclwbk.Worksheets(1)
xclApp.Visible = True
xclapp.DisplayAlerts = false
xclapp.ActiveWorkbook.SaveAs EXCEL_Path & myWorkbook
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
'xclapp.Quit
set xclapp = Nothing
Hi Dan,
"Tabelle von Basis (1)" is the Excel sheet in the German Version of SAP. You should to look at the screen and use the name of your probably English version of SAP instead. The name is visible after these commands:
. . .
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").select
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
'At this moment appears in Excel a folder whose name you must use.
Regards,
ScriptMan
Hi Dan,
I am glad if I could help you. Unfortunately, I do not know any source that contains everything about scripting. Rather, it is an experience from many projects and some good sources in Internet. Search e.g. for "WSH" (Windows Script Hosting). You will definitely find some interesting pages.
You can also look in the help for SAP GUI scripting inside of SAP (ALT / F12 -> Help for SAP GUI scripting).
My question to you: What is the name of "Tabelle von Baiss (1)" in your SAP version?
Regards,
ScriptMan
Hi Script Man,
I need one more help from you.
I have to upload number of text files in below T-code. Below is my code recorded but it doesn't allow to record browse dialog box for uploading text files.
I need script for 2 things here:
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "/nzf61"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]").sendVKey 4
session.findById("wnd[0]/tbar[1]/btn[8]").press
Thanks for your help
Hi Dan,
This issue is currently dealt with in the next thread: http://scn.sap.com/thread/3448546
I have no other solution than the ones I presented already three years ago.
Regards,
ScriptMan
Hi Script Man,
I just use your code to evaluate my problem but ı cannot link both subs to each other,
could you please help me to run sub auto_saveAs_sap after 15 seconds of sub OPEN_SESSION,
Option Explicit
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindow Lib "User32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowPlacement Lib "User32" _
(ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetWindowPlacement Lib "User32" _
(ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetForegroundWindow Lib "User32" _
(ByVal hWnd As Long) As Long
Public Declare Function BringWindowToTop Lib "User32" _
(ByVal hWnd As Long) As Long
Public Declare Function GetForegroundWindow Lib "User32" () As Long
Const WM_SETTEXT As Long = &HC
Const BM_CLICK = &HF5
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const FileSaveAsPath = "C:\Users\arda.cerit@siemens.com\Desktop\"
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim hWnd As Long
Dim Childhwnd As Long
Dim pos As RECT
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Function ActivateWindow(xhWnd As String) As Boolean
Dim Result&, WndPlcmt As WINDOWPLACEMENT
With WndPlcmt
.Length = Len(WndPlcmt)
Result = GetWindowPlacement(xhWnd, WndPlcmt)
If Result Then
If .showCmd = SW_SHOWMINIMIZED Then
.flags = 0
.showCmd = SW_SHOWNORMAL
Result = SetWindowPlacement(xhWnd, WndPlcmt)
Else
Call SetForegroundWindow(xhWnd)
Result = BringWindowToTop(xhWnd)
End If
If Result Then ActivateWindow = True
End If
End With
End Function
Private Function DeActivateWindow(xhWnd As String) As Boolean
Dim Result&, WndPlcmt As WINDOWPLACEMENT
With WndPlcmt
.Length = Len(WndPlcmt)
Result = GetWindowPlacement(xhWnd, WndPlcmt)
If Result Then
.flags = 0
.showCmd = SW_SHOWMINIMIZED
Result = SetWindowPlacement(xhWnd, WndPlcmt)
If Result Then DeActivateWindow = True
End If
End With
End Function
Sub SendMess_SaveFileNamePath(Message As String, hWnd As Long)
Call SendMessage(hWnd, WM_SETTEXT, False, ByVal Message)
End Sub
Sub main()
OPEN_SESSION
End Sub
Sub OPEN_SESSION()
Dim SapGuiAuto, aapplication, connection, session, WScript
If Not IsObject(aapplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set aapplication = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = aapplication.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject aapplication, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "lx02"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtS1_LGNUM").Text = "701"
session.findById("wnd[0]/usr/ctxtS1_LGTYP-LOW").Text = "100"
session.findById("wnd[0]/usr/ctxtS1_LGTYP-HIGH").Text = "900"
session.findById("wnd[0]/usr/ctxtS1_LGTYP-HIGH").SetFocus
session.findById("wnd[0]/usr/ctxtS1_LGTYP-HIGH").caretPosition = 3
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[1]/menu[1]").Select
session.findById("wnd[1]/usr/radRB_OTHERS").SetFocus
session.findById("wnd[1]/usr/radRB_OTHERS").Select
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "10"
session.findById("wnd[1]/tbar[0]/btn[0]").press
'Set session = Nothing
'Set connection = Nothing
'Set aapplication = Nothing
'Set SapGuiAuto = Nothing
Exit Sub
End Sub
Public Sub Auto_SaveAs_SAP()
Dim strFilename As String
strFilename = "depo.xlsx"
strFilename = FileSaveAsPath & strFilename
On Error GoTo err_handler
hWnd = FindWindow("#32770", "Save As")
If hWnd = 0 Then
MsgBox "'Save As'-dialog not found"
Exit Sub
End If
Childhwnd = FindWindowEx(hWnd, ByVal 0&, "ComboBoxEx32", "")
If Childhwnd = 0 Then
MsgBox "ComboBoxEx32 not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "ComboBox", "")
If Childhwnd = 0 Then
MsgBox "ComboBox control not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "Edit", "")
If Childhwnd = 0 Then
MsgBox "Edit control not found"
Exit Sub
End If
ActivateWindow (hWnd)
DoEvents
SendMess_SaveFileNamePath strFilename, Childhwnd
Childhwnd = FindWindowEx(hWnd, ByVal 0&, ByVal "Button", ByVal "Open as &read-only")
Childhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
If Childhwnd = 0 Then
MsgBox "Save Button in 'Save As'-dialog not found"
Exit Sub
End If
SendMessage Childhwnd, BM_CLICK, 0, ByVal 0&
Exit Sub
err_handler:
MsgBox Err.Description
End Sub
after I run below code I refer to saveas macro to run but it doesn't
Sub main()
OPEN_SESSION
End Sub
Sub OPEN_SESSION()
Dim SapGuiAuto, aapplication, connection, session, WScript
If Not IsObject(aapplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set aapplication = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = aapplication.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject aapplication, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "lx02"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxtS1_LGNUM").Text = "701"
session.findById("wnd[0]/usr/ctxtS1_LGTYP-LOW").Text = "100"
session.findById("wnd[0]/usr/ctxtS1_LGTYP-HIGH").Text = "900"
session.findById("wnd[0]/usr/ctxtS1_LGTYP-HIGH").SetFocus
session.findById("wnd[0]/usr/ctxtS1_LGTYP-HIGH").caretPosition = 3
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[1]/menu[1]").Select
session.findById("wnd[1]/usr/radRB_OTHERS").SetFocus
session.findById("wnd[1]/usr/radRB_OTHERS").Select
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "10"
Set session = Nothing
Set connection = Nothing
Set aapplication = Nothing
Set SapGuiAuto = Nothing
application.Run "Auto_SaveAs_SAP()"
End Sub
Hello Holger
I was exporting with txt method but it isn't so good in some reports (with values)
I tried to use your code but I didn't get success ... Could help me telling where I should put the "call" to the Function Auto_SaveAs_SAP?
Sub BDFAT()
Set sap = New GuiApplication
Set SapGuiAuto = GetObject("SAPGUI")
Set Connection = sap.OpenConnection(Cells(7, 4))
Set session = Connection.Children(0)
session.FindById("wnd[0]/usr/txtRSYST-BNAME").Text = Cells(5, 4)
session.FindById("wnd[0]/usr/pwdRSYST-BCODE").Text = Cells(6, 4)
session.FindById("wnd[0]").SendVKey 0
If session.Children.Count > 1 Then
session.FindById("wnd[1]/usr/radMULTI_LOGON_OPT2").Select
session.FindById("wnd[1]/usr/radMULTI_LOGON_OPT2").SetFocus
session.FindById("wnd[1]/tbar[0]/btn[0]").press
End If
session.StartTransaction "SQ01"
session.FindById("wnd[0]/usr/ctxtRS38R-QNUM").Text = "SD109"
session.FindById("wnd[0]").SendVKey 8
session.FindById("wnd[0]").SendVKey 17
session.FindById("wnd[1]/usr/txtV-LOW").Text = "IND LM"
session.FindById("wnd[1]/usr/txtENAME-LOW").Text = "LUCCAR"
session.FindById("wnd[1]").SendVKey 8
session.FindById("wnd[0]/usr/ctxtJ5_PDATE-LOW").Text = Cells(8, 5)
session.FindById("wnd[0]/usr/ctxtJ5_PDATE-HIGH").Text = Cells(8, 6)
session.FindById("wnd[0]/usr/ctxtJ5_DDATE-LOW").Text = Cells(8, 5)
session.FindById("wnd[0]/usr/ctxtJ5_DDATE-HIGH").Text = Cells(8, 6)
session.FindById("wnd[0]").SendVKey 8
session.FindById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.FindById("wnd[1]/usr/cmbG_LISTBOX").Key = "10"
session.FindById("wnd[1]/tbar[0]/btn[0]").press
'here is the end of the code, where the Save_As Dialog appears.
Set session = Nothing
Set Connection = Nothing
Set SapGuiAuto = Nothing
Set sap = Nothing
End Sub
Hi Script Man,
Hope you are doing well.
I hope you will help me in one query after downloading the report.
Can I make my sheet name variable as you did for workbook and path as below.
SAP_Workbook = "Tabelle von Basis (1)"
EXCEL_Path = "C:\SAP\"
myWorkbook = "Report.xlsx"
Whenever report is downloaded in Report Workbook File, I need to give the sheet name of my choice and it should not save with Sheet1.
Can I make sheet name variable?
Thanks in Advance
HI script man,
Hope you are doing well
happy new year in advance
i tried your code to auto save the excel file but it is not working for me as im new to this. could you please help me where im wrong
Public Sub SAPExport()
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPapp = SapGuiAuto.GetScriptingEngine
Set SAPCon = SAPapp.Children(0)
Set session = SAPCon.Children(0)
Set macrobook = ActiveWorkbook
Sheets("sheet1").Select
Range("a5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nyumm_md0007"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/btn%_SP$00001_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[16]").press
session.findById("wnd[1]/tbar[0]/btn[24]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]").sendVKey 8
session.findById("wnd[0]").maximize
SAP_Workbook = "Worksheet"
EXCEL_Path = "C:\Users\Shashank.N\Desktop"
myWorkbook = "export.xlsx"
On Error Resume Next
Do
Err.Clear
Set xclapp = GetObject(, "Excel.Application")
If Err.Number = 0 Then Exit Do
'msgbox "Wait for Excel session"
wscript.sleep 2000
Loop
Do
Err.Clear
Set xclwbk = xclapp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then Exit Do
'msgbox "Wait for SAP workbook"
wscript.sleep 2000
Loop
On Error GoTo 0
Set xclsheet = xclwbk.Worksheets(1)
xclapp.Visible = True
xclapp.DisplayAlerts = False
xclapp.ActiveWorkbook.SaveAs EXCEL_Path & myWorkbook
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
'xclapp.Quit
Set xclapp = Nothing
End Sub
Hi Script Man, Hello everybody,
perhaps somebody could help me with my code. I have a problem with saving the spreadsheet exported from SAP. I read all posts, but I still get an error. When I run code it generates Excel file but doesn't save it, and program is running like forever until it's stuck.
I changed German name "Tabelle von Basis (1)" to Polish name "Arkusz w basis (1)", since I have Excel in Polish.
I also deleted this line:
"Set Application = SapGuiAuto.GetScriptingEngine"
because I was getting error message for word "Application" (invalid use of property).
So, here is my code, maybe somebody could help:
...
'RECORDING ACTIONS IN SAP
If Not IsObject(Application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set Application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = Application.Children(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject Application, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/usr/chkP_PROCES").Selected = False
session.findById("wnd[0]/usr/ctxtSEL_BUKR-LOW").Text = "038"
session.findById("wnd[0]/usr/chkP_PROCES").SetFocus
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/usr/cntlTOP_CONTAINER/shellcont/shell").setCurrentCell -1, "WC_ICON"
session.findById("wnd[0]/usr/cntlTOP_CONTAINER/shellcont/shell").selectColumn "WC_ICON"
session.findById("wnd[0]/usr/cntlTOP_CONTAINER/shellcont/shell").pressToolbarContextButton "&MB_FILTER"
session.findById("wnd[0]/usr/cntlTOP_CONTAINER/shellcont/shell").selectContextMenuItem "&FILTER"
session.findById("wnd[1]").sendVKey 4
session.findById("wnd[2]").sendVKey 2
session.findById("wnd[1]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/btn%_%%DYN001_%_APP_%-VALU_PUSH").press
session.findById("wnd[2]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").SetFocus
session.findById("wnd[2]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").caretPosition = 0
session.findById("wnd[2]").sendVKey 4
session.findById("wnd[3]/usr/lbl[1,5]").SetFocus
session.findById("wnd[3]/usr/lbl[1,5]").caretPosition = 0
session.findById("wnd[3]").sendVKey 2
session.findById("wnd[2]/tbar[0]/btn[8]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[0]/usr/cntlTOP_CONTAINER/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/cntlTOP_CONTAINER/shellcont/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "08"
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
'code from forum:
SAP_Workbook = "Arkusz w Basis (1)"
EXCEL_Path = "C:\Users\msuzdorf\Desktop"
myWorkbook = "Report.xlsx"
On Error Resume Next
Do
Err.Clear
Set xclapp = GetObject(, "Excel.Application")
If Err.Number = 0 Then Exit Do
'MsgBox "Wait for Excel session"
WScript.sleep 2000
Loop
Do
Err.Clear
Set xclwbk = xclapp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then Exit Do
'MsgBox "Wait for SAP workbook"
WScript.sleep 2000
Loop
On Error GoTo 0
Set xclsheet = xclwbk.Worksheets(1)
xclapp.Visible = True
xclapp.DisplayAlerts = False
xclapp.ActiveWorkbook.SaveAs EXCEL_Path & myWorkbook
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
xclapp.Quit
Set xclapp = Nothing
Thank you in advance.
Hi Script Man,
thank you for your advice. In the end I managed to solve it. It was simple, I just had to delete one line in my code, this one:
session.findById("wnd[1]/tbar[0]/btn[0]").press
It was closing the msgbox in sap "Save the data in the spreadsheet". After executing this line I was not able to save my Excel file. After deleting it's OK.
Best regards,
Mateusz
There is another solution: you can select download by local file instead of spreadsheet.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Ok, how do I need to set up this loop? Because it needs to run in the background right.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hello Holger,
I am now facing the same issue as some people above have faced,
Namely if I run my recorded SAP script, and the SAVE_AS window pops up, then my scripts freezes before I can call the Save_as macro.
This is how it looks now:
...
session.findById("wnd[0]/usr/cntlZ_ALV/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/cntlZ_ALV/shellcont/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/tbar[0]/btn[0]").press
'Save to spreadsheet'
session.findById("wnd[0]/tbar[1]/btn[16]").press
End Sub
Sub Save()
Workbooks.Open "C:\Users\jvandebo\Documents\Studies\DN overview test\Auto save.xlsm"
Application.Run "'Auto save.xlsm'!SaveAs"
Workbooks("Auto save.xlsm").Close
End Sub
I call both subs via a seperated sub.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Indeed if i remove the code then it works.
'Application.DisplayAlerts = False
'If Dir(strFilename) Then Kill strFilename
Application.DisplayAlerts = True
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hey,
I think the error is in here:
Application.DisplayAlerts = False
If Dir(strFilename) Then Kill strFilename
Application.DisplayAlerts = True
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
It runs fine until
strFilename = InputBox("Filename:", "FileName ('C:\tmp\' is default path)", "MyTestFile")
If I press OK in the Pop up window, it gives a "Type mismatch" window.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hello,
Can please somebody help, if I try to run the AutSave_as macro it gives a "Type mismatch" error.
I just copied the script and edited the path name:
Option Explicit
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindow Lib "User32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowPlacement Lib "User32" _
(ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetWindowPlacement Lib "User32" _
(ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetForegroundWindow Lib "User32" _
(ByVal hWnd As Long) As Long
Public Declare Function BringWindowToTop Lib "User32" _
(ByVal hWnd As Long) As Long
Public Declare Function GetForegroundWindow Lib "User32" () As Long
Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" _
(ByVal lpPath As String) As Long
Const WM_SETTEXT As Long = &HC
Const BM_CLICK = &HF5
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const FileSaveAsPath = "C:\Users\jvandebo\Desktop"
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim hWnd As Long
Dim Childhwnd As Long
Dim pos As RECT
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Function ActivateWindow(xhWnd As String) As Boolean
Dim Result&, WndPlcmt As WINDOWPLACEMENT
With WndPlcmt
.Length = Len(WndPlcmt)
Result = GetWindowPlacement(xhWnd, WndPlcmt)
If Result Then
If .showCmd = SW_SHOWMINIMIZED Then
.flags = 0
.showCmd = SW_SHOWNORMAL
Result = SetWindowPlacement(xhWnd, WndPlcmt)
Else
Call SetForegroundWindow(xhWnd)
Result = BringWindowToTop(xhWnd)
End If
If Result Then ActivateWindow = True
End If
End With
End Function
Private Function DeActivateWindow(xhWnd As String) As Boolean
Dim Result&, WndPlcmt As WINDOWPLACEMENT
With WndPlcmt
.Length = Len(WndPlcmt)
Result = GetWindowPlacement(xhWnd, WndPlcmt)
If Result Then
.flags = 0
.showCmd = SW_SHOWMINIMIZED
Result = SetWindowPlacement(xhWnd, WndPlcmt)
If Result Then DeActivateWindow = True
End If
End With
End Function
Sub SendMess_SaveFileNamePath(Message As String, hWnd As Long)
Call SendMessage(hWnd, WM_SETTEXT, False, ByVal Message)
End Sub
Public Sub Auto_SaveAs_SAP()
Dim strFilename As String
On Error GoTo err_handler
hWnd = FindWindow("#32770", "Save As")
If hWnd = 0 Then
MsgBox "'Save As'-dialog not found"
Exit Sub
End If
Childhwnd = FindWindowEx(hWnd, ByVal 0&, "ComboBoxEx32", "")
If Childhwnd = 0 Then
MsgBox "ComboBoxEx32 not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "ComboBox", "")
If Childhwnd = 0 Then
MsgBox "ComboBox control not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "Edit", "")
If Childhwnd = 0 Then
MsgBox "Edit control not found"
Exit Sub
End If
strFilename = InputBox("Filename:", "FileName ('C:\tmp\' is default path)", "MyTestFile")
strFilename = FileSaveAsPath & strFilename
'If Right(FileSaveAsPath, 1) <> "C:\Users\jvandebo\Desktop" Then FileSaveAsPath = FileSaveAsPath & "C:\Users\jvandebo\Desktop"
If MakePath(FileSaveAsPath) = 0 Then
MsgBox FileSaveAsPath, vbInformation, "Pfad konnte nicht angelegt werden."
End If
Application.DisplayAlerts = False
If Dir(strFilename) Then Kill strFilename
Application.DisplayAlerts = True
ActivateWindow (hWnd)
DoEvents
SendMess_SaveFileNamePath strFilename, Childhwnd
Childhwnd = FindWindowEx(hWnd, ByVal 0&, ByVal "Button", ByVal "Open as &read-only")
Childhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
If Childhwnd = 0 Then
MsgBox "Save Button in 'Save As'-dialog not found"
Exit Sub
End If
SendMessage Childhwnd, BM_CLICK, 0, ByVal 0&
Exit Sub
err_handler:
MsgBox Err.Description
End Sub
Sub path_WB()
MsgBox ThisWorkbook.Path
End Sub
Thanks in advance
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hello Script Man,
I wanted to add your code to enable the auto save but I'm not able to make it work.
Here is my script. There are four "moments" where I'd like to enable the auto save.
Could you please check it and advice where and what exactly to add to make it work?
Thank you in advance!
Petr
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "/nsq01"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[19]").press
session.findById("wnd[1]/usr/cntlGRID1/shellcont/shell").currentCellRow = 6
session.findById("wnd[1]/usr/cntlGRID1/shellcont/shell").selectedRows = "6"
session.findById("wnd[1]/usr/cntlGRID1/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").currentCellRow = 28
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").selectedRows = "28"
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
session.findById("wnd[0]/tbar[0]/okcd").text = "/nsq01"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[19]").press
session.findById("wnd[1]/usr/cntlGRID1/shellcont/shell").currentCellRow = 6
session.findById("wnd[1]/usr/cntlGRID1/shellcont/shell").selectedRows = "6"
session.findById("wnd[1]/usr/cntlGRID1/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").currentCellRow = 27
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").firstVisibleRow = 26
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").selectedRows = "27"
session.findById("wnd[0]/usr/cntlGRID_CONT0050/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").setCurrentCell 1,"TEXT"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "1"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[4]/menu[0]/menu[1]").select
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").setCurrentCell 1,"TEXT"
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectedRows = "1"
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").clickCurrentCell
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
session.findById("wnd[0]/tbar[0]/okcd").text = "/nmb5t"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[1]/menu[2]").select
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[1,0]").select
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[1,0]").setFocus
session.findById("wnd[1]").sendVKey 0
session.findById("wnd[1]/usr/ctxtDY_PATH").setFocus
session.findById("wnd[1]/usr/ctxtDY_PATH").caretPosition = 0
session.findById("wnd[1]").sendVKey 4
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[0]/tbar[0]/okcd").text = "/nmb52"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").setCurrentCell 1,"TEXT"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "1"
session.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[1]/menu[1]").select
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hi Script Man,
I have follow the step which you provide but i am unable to save the report automatically.
When i run the code it’s create automatically pivot but not save in the path which i have provided.
Can you please check below code and help me?
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "/nzk97"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/btn%_DD_KUNNR_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL-SLOW_I[1,0]").text = "10004638"
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL-SLOW_I[1,1]").text = "10054329"
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL-SLOW_I[1,1]").setFocus
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL-SLOW_I[1,1]").caretPosition = 8
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
session.findById("wnd[1]/usr/radRB_OTHERS").setFocus
session.findById("wnd[1]/usr/radRB_OTHERS").select
session.findById("wnd[1]/usr/cmbG_LISTBOX").key = "08"
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
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]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
SAP_Workbook = "Worksheet in ALVXXL01 (1)"
EXCEL_Path = "C:\Users\rahul.chure\Documents\SAP\"
myWorkbook = "zk97.xlsx"
on error resume next
do
err.clear
Set xclApp = GetObject(, "Excel.Application")
If Err.Number = 0 Then exit do
'msgbox "Wait for Excel session"
wscript.sleep 2000
loop
do
err.clear
Set xclwbk = xclApp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then exit do
'msgbox "Wait for SAP workbook"
wscript.sleep 2000
loop
on error goto 0
Set xclSheet = xclwbk.Worksheets(1)
xclApp.Visible = True
xclapp.DisplayAlerts = false
xclapp.ActiveWorkbook.SaveAs EXCEL_Path & myWorkbook
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
'xclapp.Quit
set xclapp = Nothing
Thanks in advance.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hi Rahul,
you can try the following:
. . .
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
session.findById("wnd[1]/usr/radRB_OTHERS").setFocus
session.findById("wnd[1]/usr/radRB_OTHERS").select
session.findById("wnd[1]/usr/cmbG_LISTBOX").key = "08"
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
'session.findById("wnd[1]/tbar[0]/btn[0]").press
'session.findById("wnd[1]/tbar[0]/btn[0]").press
'the rows are deactivated
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[0,0]").select
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
SAP_Workbook = "Worksheet in ALVXXL01 (1)"
. . .
Regards,
ScriptMan
Dear Script Man,
Thank you so much for sharing your knowledge about SAP GUI script. I wonder if we can connect to develop some business applications that has some commercial values. There is currently a need in our company to do something like this - needs some more refinement. It can save a lot of time for a lot of SAP users.
If you are interested, please drop me an email note, Kevinwu64@yahoo.com
Look forward to work with you,
Kevin
Dear Dan,
This issue is similar to what I'm facing now (refer here: http://scn.sap.com/thread/3448546) and faced by a few other users before this.
The Save File dialog box (in my case the Import File) is not an SAP Screen (dynpro) but a native Windows screen. You can confirm this by looking at Windows Task Manager under running applications when the dialog box pops up.
In your script above, the dialog box pops up after the following lines (which is recorded when you go for List > Export File > Spreadsheet from the SAP menu):
..
...
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").select
session.findById("wnd[1]/tbar[0]/btn[0]").press
When the dialog box come up, the script is halted until a parameter is return or the cancel key is pressed. SAP Script recorder does not record this since it does not fall under SAP screen like I mentioned earlier. Hence you do not see the expected text field in your recorded script.
The workaround in VBS is available but be warned that it is not a straight forward solution. It involves running a few scripts at once. You can refer the thread here: http://scn.sap.com/thread/1226566 and here: http://scn.sap.com/thread/1799453
As for me, I'm trying to imitate the solution concept in Excel VBA, but have not been successful yet.
Thanks
Sayuti
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hello. Below an Excel VBA Coding how I have solved this using USER32 API functions:
Let your script run until SAP SaveAs Dialog appear. Then run Sub Auto_SaveAs_SAP
So you will see how the function is working. Thn you can adopt it to your requirements. Take care to modify all path/Directory to your Setup.
'-----------------------------------------Start Excel VBA Coding---------------------------------------
Option Explicit
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindow Lib "User32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowPlacement Lib "User32" _
(ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetWindowPlacement Lib "User32" _
(ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function SetForegroundWindow Lib "User32" _
(ByVal hWnd As Long) As Long
Public Declare Function BringWindowToTop Lib "User32" _
(ByVal hWnd As Long) As Long
Public Declare Function GetForegroundWindow Lib "User32" () As Long
Declare Function MakePath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" _
(ByVal lpPath As String) As Long
Const WM_SETTEXT As Long = &HC
Const BM_CLICK = &HF5
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const FileSaveAsPath = "C:\tmp\"
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim hWnd As Long
Dim Childhwnd As Long
Dim pos As RECT
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Function ActivateWindow(xhWnd As String) As Boolean
Dim Result&, WndPlcmt As WINDOWPLACEMENT
With WndPlcmt
.Length = Len(WndPlcmt)
Result = GetWindowPlacement(xhWnd, WndPlcmt)
If Result Then
If .showCmd = SW_SHOWMINIMIZED Then
.flags = 0
.showCmd = SW_SHOWNORMAL
Result = SetWindowPlacement(xhWnd, WndPlcmt)
Else
Call SetForegroundWindow(xhWnd)
Result = BringWindowToTop(xhWnd)
End If
If Result Then ActivateWindow = True
End If
End With
End Function
Private Function DeActivateWindow(xhWnd As String) As Boolean
Dim Result&, WndPlcmt As WINDOWPLACEMENT
With WndPlcmt
.Length = Len(WndPlcmt)
Result = GetWindowPlacement(xhWnd, WndPlcmt)
If Result Then
.flags = 0
.showCmd = SW_SHOWMINIMIZED
Result = SetWindowPlacement(xhWnd, WndPlcmt)
If Result Then DeActivateWindow = True
End If
End With
End Function
Sub SendMess_SaveFileNamePath(Message As String, hWnd As Long)
Call SendMessage(hWnd, WM_SETTEXT, False, ByVal Message)
End Sub
Public Sub Auto_SaveAs_SAP()
Dim strFilename As String
On Error GoTo err_handler
hWnd = FindWindow("#32770", "Save As")
If hWnd = 0 Then
MsgBox "'Save As'-dialog not found"
Exit Sub
End If
Childhwnd = FindWindowEx(hWnd, ByVal 0&, "ComboBoxEx32", "")
If Childhwnd = 0 Then
MsgBox "ComboBoxEx32 not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "ComboBox", "")
If Childhwnd = 0 Then
MsgBox "ComboBox control not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "Edit", "")
If Childhwnd = 0 Then
MsgBox "Edit control not found"
Exit Sub
End If
strFilename = InputBox("Filename:", "FileName ('C:\tmp\' is default path)", "MyTestFile")
strFilename = FileSaveAsPath & strFilename
'If Right(FileSaveAsPath, 1) <> "\" Then FileSaveAsPath = FileSaveAsPath & "\"
If MakePath(FileSaveAsPath) = 0 Then
MsgBox FileSaveAsPath, vbInformation, "Pfad konnte nicht angelegt werden."
End If
Application.DisplayAlerts = False
If Dir(strFilename) Then Kill strFilename
Application.DisplayAlerts = True
ActivateWindow (hWnd)
DoEvents
SendMess_SaveFileNamePath strFilename, Childhwnd
Childhwnd = FindWindowEx(hWnd, ByVal 0&, ByVal "Button", ByVal "Open as &read-only")
Childhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
If Childhwnd = 0 Then
MsgBox "Save Button in 'Save As'-dialog not found"
Exit Sub
End If
SendMessage Childhwnd, BM_CLICK, 0, ByVal 0&
Exit Sub
err_handler:
MsgBox Err.Description
End Sub
Sub path_WB()
MsgBox ThisWorkbook.Path
End Sub
'-----------------------------------------End of Excel VBA Coding---------------------------------------
Br, Holger
Holger,
I am trying to use your code for capturing SAVE AS Dialog window and updating the value. This code works perfectly fine on Windows 7 / English but fails on Windows 7 / German environment.
I have figured out since we use the windows title in our search, it has to be adjusted as per the OS Language.
hwnd = FindWindow("#32770", "SAVE As")
hwnd = FindWindow("#32770", "Speichern unter")
This works fine. But after that the program does not works in German OS. Can you look at the code and suggest changes. Requirement is following.
1. Based on OS Langauge, code should look for SAVE AS or Speichern Unter
2. Function should work in both the EN & German langauge.
Thanks
Amit
---------------------------------------------------------------------------------------------------------------------
Public Sub Auto_SaveAs_SAP(strFilename As String)
Dim NewName1 As String
Dim CountWait As Integer
On Error GoTo err_handler
'hwnd = FindWindow("#32770", "Save As")
'MsgBox Application.LanguageSettings.LanguageID(msoLanguageIDUI)
CountWait = 0
Do
hwnd = FindWindow("#32770", "Speichern unter")
Application.Wait (Now + TimeValue("0:00:01"))
If hwnd = 0 Then
CountWait = CountWait + 1
If CountWait = 15 Then
MsgBox "Speichern unter nicht gefunden", vbCritical
Exit Sub
End If
End If
Loop Until hwnd
If hwnd = 0 Then
MsgBox "'Save As'-dialog not found"
Exit Sub
End If
Childhwnd = FindWindowEx(hwnd, ByVal 0&, "ComboBoxEx32", "")
If Childhwnd = 0 Then
MsgBox "ComboBoxEx32 not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "ComboBox", "")
If Childhwnd = 0 Then
MsgBox "ComboBox control not found"
Exit Sub
End If
Childhwnd = FindWindowEx(Childhwnd, ByVal 0&, "Edit", "")
If Childhwnd = 0 Then
MsgBox "Edit control not found"
Exit Sub
End If
'Detect and Delete Existing File
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
With FSO
If .FileExists(strFilename) Then
NewName1 = Left(strFilename, Len(strFilename) - 4) & "_Backup_" & Format(Now, "ddmmyy-hhmm")
Name strFilename As NewName1 & ".pdf"
End If
End With
ActivateWindow (hwnd)
DoEvents
SendMess_SaveFileNamePath strFilename, Childhwnd
Childhwnd = FindWindowEx(hwnd, ByVal 0&, ByVal "Button", ByVal "Open as &read-only")
Childhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
If Childhwnd = 0 Then
MsgBox "Save Button in 'Save As'-dialog not found"
Exit Sub
End If
SendMessage Childhwnd, BM_CLICK, 0, ByVal 0&
Exit Sub
err_handler:
MsgBox Err.Description
End Sub
Hello Amit.
If you Change OS language of course all controls identified with english descriptions Need to check and changed to german language:
I suggest you use Spy application to findout german text value.
e.g.
Childhwnd = FindWindowEx(hwnd, ByVal 0&, ByVal "Button", ByVal "Open as &read-only")
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.