SAP - Deal with the "Save As" dialog box with VBA and/or VBS

YounesB3

Board Regular
Joined
Mar 28, 2012
Messages
148
Hello,

I'm currently trying to write a script that will run the KSB1 transaction in SAP and download the output to a specific location. The problem is when the Save As Dialog box come up. Since that dialog box is generated by Windows, the SAP GUI scripting doesn't record it. Newer version of SAP has a solution for this, but unfortunately, I'm running an old one. I can get VBA to get to the point of opening up the dialogue box but I can't get it to fill in the filename and then hit save.

I've tried many things from sap archive, but the solutions of Script Man or Holger Kohn don't seem to work for me. I'm talking about those threads :

Script recording doesn'''t record save of file

Help required to activate saved workbook from SAP while VBA script is running

Holger Kohn's solution:

Code:
''https://archive.sap.com/discussions/thread/3361288'
'Option Explicit
'
'Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
'(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'
''Declares a reference to a procedure implemented in an external file.
''Introduces a Lib clause, which identifies the external file (DLL or code resource) containing an external procedure.
''ByVal Specifies that an argument is passed in such a way that the called procedure or property cannot change the value of a variable underlying the argument in the calling code.
' 'ByVal does not prevent changing the value of a field or property.
' 'ByVal does prevent changing the value of c1 itself.
'
'Public 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
'
'Public 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 'Sets the text of a window.
'Const BM_CLICK = &HF5
'Const GW_CHILD = 5
'Const GW_HWNDNEXT = 2
'
'Type RECT 'Type used at module level to define a user-defined data type containing one or more elements. Public by default.
'    Left As Long
'    Top As Long
'    Right As Long
'    Bottom As Long
'End Type
'
'Dim Ret As Long, OpenRet As Long, FlDwndHwnd As Long
'Dim ChildRet As Long
'Dim pos As RECT
'
'Const SW_SHOWNORMAL = 1
'Const SW_SHOWMINIMIZED = 2
'
'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
'
'Public Function ActivateWindow(xhWnd&) 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
'
'Public Function DeActivateWindow(xhWnd&) 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(Message As String, hWnd As Long)
'    Call SendMessage(hWnd, WM_SETTEXT, False, ByVal Message)
'End Sub
'
'Public Sub Auto_SaveAs_SAP()
'
'On Error GoTo err_handler
'
''******************************************************************************************************************
''*                                                                                                                *
''* Automatic 'Save as' dialog from SAP => fillin SaveAsFileName and press 'Save'                                  *
''*                                                                                                                *
''******************************************************************************************************************
'
'    Ret = FindWindow("#32770", "Save As")
'
'    If Ret = 0 Then
'       MsgBox "Save As Window Not Found"
'       Exit Sub
'    End If
'
'    '==> Get the handle of  ComboBoxEx32
'    'ComboBoxEx controls are combo box controls that provide native support for item images.
'    ChildRet = FindWindowEx(Ret, ByVal 0&, "ComboBoxEx32", "")
'    If ChildRet = 0 Then
'        MsgBox "ComboBoxEx32 Not Found"
'        Exit Sub
'    End If
'
'     '==> Get the handle of the Main ComboBox
'     ChildRet = FindWindowEx(ChildRet, ByVal 0&, "ComboBox", "")
'
'     If ChildRet = 0 Then
'         MsgBox "ComboBox Window Not Found"
'         Exit Sub
'     End If
'
'     '==> Get the handle of the Edit
'     ChildRet = FindWindowEx(ChildRet, ByVal 0&, "Edit", "")
'
'     If ChildRet = 0 Then
'         MsgBox "Edit Window Not Found"
'         Exit Sub
'     End If
'
'     ActivateWindow (Ret)
'
'     '==> fillin FileName in 'Save As' Edit
'     DoEvents
'     SendMess FileSaveAsName, ChildRet
'
'     '==> Get the handle of the Save Button in the Save As Dialog Box
'     ChildRet = FindWindowEx(Ret, ByVal 0&, ByVal "Button", ByVal "Open as &read-only")
'     ChildRet = GetWindow(ChildRet, GW_HWNDNEXT) ' This will be handle of '&Save'-Button
'
'     '==> Check if we found it or not
'     If ChildRet = 0 Then
'         MsgBox "Save Button in Save As Window Not Found"
'         Exit Sub
'     End If
'
'     '==> press Save-button
'     SendMessage ChildRet, BM_CLICK, 0, ByVal 0&
'     Exit Sub
'
'err_handler:
'MsgBox Err.Description
'End Sub

This solution of Holger Kohn actually works when the dialog is already there and I then start a new VBA procedure. The problem is that when VBA opens the Save As dialog box, it will stop executing the code as long as the user doesn't click on a location to save the file or presses cancel. So I can't make VBA call the "Auto_SaveAs_SAP" macro. What he suggested to someone else is to loop from another instance of Excel. I'm not sure what he means by that because you can't run to macros at the same time, unless it's from a separate computer altogether which me or another user running the report won't have access to.

If I'm missing something here, please let me know.

Here is Script Man's solution. In VBA:

Code:
Set Wshell = CreateObject("WScript.Shell")
Wshell.Run """[Path of vbs file including extension]""" & [Path of export file including extension], 1, False

In VBS:

Code:
if Wscript.Arguments.count > 0 then
 set fs = CreateObject("Scripting.FileSystemObject")
 if fs.fileExists(WScript.arguments(0)) then
  Set myfile = fs.GetFile(WScript.arguments(0)) 
  myfile.Delete
 end if
 set Wshell = CreateObject("WScript.Shell")
 Do 
  bWindowFound = Wshell.AppActivate("Save As")
  WScript.Sleep 1000
 Loop Until bWindowFound
 
 Do 
     Wshell.sendkeys "{TAB}"
     Wshell.sendkeys "{TAB}"
     Wshell.sendkeys "{TAB}"
     Wshell.sendkeys "{TAB}"
  Wshell.appActivate "Save As"
  Wshell.sendkeys WScript.arguments(0)
  WScript.Sleep 400
  Wshell.appActivate "Save As"
  Wshell.sendkeys "%s"
  WScript.Sleep 400
  bWindowFound = Wshell.AppActivate("Save As")
  WScript.Sleep 400
 Loop Until not bWindowFound
end if

I've tried many different instances of this and all it does is open the VBS file without actually doing anything else.

I'm kind of desperate now... Please help!

Note: Cross-post: SAP - Deal with the "Save As" dialog box with VBA and/or VBS
 
Last edited:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Have you considered using the vba GetSaveAsFilename function which allows you to set the default file name when saving?
But then again, I guess, you also want to have the save button pressed automatically.

I have never used SAP that's peobably why I don't see in the two codes you posted, any line that invokes the Windows SaveAs dialog.

Also, I have a question. Are you running this from VBA or from VBS ?

I think I should be able to write code in VBA that invokes the Windows SaveAs dialog with the file name already filled in as well as to write code that hits the Save button programmatically .. I can show you an example but it will be up to you integrate the code with your existing VBA/VBS.
 
Last edited:
Upvote 0
Have you considered using the vba GetSaveAsFilename function which allows you to set the default file name when saving?
But then again, I guess, you also want to have the save button pressed automatically.

I have never used SAP that's peobably why I don't see in the two codes you posted, any line that invokes the Windows SaveAs dialog.

It's from the SAP GUI script. The code I posted isn't my main code. It's only the codes I tried integrating in my code. I don't think it's really relevent, but just in case, here's is my full code (in red line is the line which opens the Windows Save As Dialog box; for now it's managed manually):

Code:
Public C2 As Boolean
Private Const Foldermapping = "[Removed for security reasons]"


Sub [Removed for security reasons]()


Dim i, Lastrow As Long
Dim Costcenter, Validation_path As String


Lastrow = Worksheets(Foldermapping).Range("A" & Rows.count).End(xlUp).Row


'Remove formatting
With Worksheets(Foldermapping).Rows("4:" & Lastrow)
    .Interior.Pattern = xlSolid
    .Interior.PatternColorIndex = xlAutomatic
    .Interior.ThemeColor = xlThemeColorDark1
    .Interior.TintAndShade = 0
    .Interior.PatternTintAndShade = 0
    .Font.ColorIndex = xlAutomatic
    .Font.TintAndShade = 0
End With


'Sort
With Worksheets(Foldermapping).Sort
    .SetRange Range("A5:F" & Lastrow)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


'Highlight each path not found
For i = 5 To Lastrow
    Costcenter = Worksheets(Foldermapping).Cells(i, 1).Value
    Validation_path = Worksheets(Foldermapping).Cells(i, 6).Value


    If Dir(Validation_path, vbDirectory) = "" Then
        MsgBox [Removed for security reasons], vbExclamation, "Not Found!"
        With Rows(i)
            .Interior.Pattern = xlSolid
            .Interior.PatternColorIndex = xlAutomatic
            .Interior.Color = 255
            .Interior.TintAndShade = 0
            .Interior.PatternTintAndShade = 0
            .Font.ThemeColor = xlThemeColorDark1
            .Font.TintAndShade = 0
        End With
    End If
Next i


MsgBox [Removed for security reasons], vbInformation, "Process ran successfully!"


C2 = 1


End Sub


Sub [Removed for security reasons]()


Call Validation_Longview


If C2 = 0 Then
    MsgBox "The 'Validation_path' macro for the '" & Foldermapping & "' tab wasn't run prior to this macro. " _
    & "Please follow the procedure", vbCritical, "Please follow the procedure!"
    Exit Sub
End If


Dim Per, Year, Month, Date1, Date2 As String
Dim LastrowFM, LastrowKSB1, LastrowDest, LastrowDestPivot, LastrowSALR As Long
Dim vari, Node, FileCC, Filepath, [Removed for security reasons], Filename, Filename2, FileComb As String
Dim i, wscount As Long
Dim FSO
Dim WS As Worksheet
Dim WBtxt, MainWB, DestWB As Workbook
Dim SAPGUIAuto, Wshell As Object
Dim SAPApp, SAPCon, session, WScript As Variant
Set MainWB = ActiveWorkbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Per = Worksheets(Foldermapping).Range("B1").Value
Year = Worksheets(Foldermapping).Range("B2").Value
Month = Worksheets(Foldermapping).Range("D1").Value
Date1 = Worksheets(Foldermapping).Range("F1").Value
Date2 = Worksheets(Foldermapping).Range("F2").Value
LastrowFM = Worksheets(Foldermapping).Range("A" & Rows.count).End(xlUp).Row
vari = [Removed for security reasons]
KSB1R14 = [Removed for security reasons]


'Txt file to use as variant
With Sheets(Foldermapping)
    .Range("A5:A" & LastrowFM).Copy
    Set WBtxt = Workbooks.Add
    WBtxt.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    WBtxt.SaveAs vari, xlText
    WBtxt.Close SaveChanges:=True
End With


'Catch and redirect errors in case SAP GUI is not open or not accessible
On Error GoTo NotConnected


Set SAPGUIAuto = GetObject("SAPGUI")  'Get the SAP GUI Scripting object
Set SAPApp = SAPGUIAuto.GetScriptingEngine 'Get the currently running SAP GUI
Set SAPCon = SAPApp.Children(0) 'Get the first system that is currently connected
Set session = SAPCon.Children(0) 'Get the first session (window) on that connection


If IsObject(WScript) Then
   WScript.ConnectObject session, "on"
   WScript.ConnectObject Application, "on"
End If


'Return to regular error handling
On Error GoTo 0


'KSB1
session.StartTransaction "KSB1"
session.findById("wnd[0]/usr/btn%_KOSTL_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[16]").press
Workbooks.Open vari
Range("A1:A" & LastrowFM - 4).Copy
session.findById("wnd[1]/tbar[0]/btn[24]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
ActiveWorkbook.Close SaveChanges:=False
session.findById("wnd[0]/usr/ctxtKSTGR").Text = ""
session.findById("wnd[0]/usr/btn%_KSTAR_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[16]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/usr/ctxtKOAGR").Text = "CP2003"
session.findById("wnd[0]/usr/ctxtR_BUDAT-LOW").Text = Date1
session.findById("wnd[0]/usr/ctxtR_BUDAT-HIGH").Text = Date2
session.findById("wnd[0]/usr/ctxtP_DISVAR").Text = [Removed for security reasons]
session.findById("wnd[0]/tbar[1]/btn[8]").press


'Catch and redirect errors in case SAP's date format do not match Excel's.
On Error GoTo Dateformat


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


'Return to regular error handling
On Error GoTo 0


'Layout
session.findById("wnd[0]/tbar[1]/btn[32]").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "1"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "2"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "2"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "2"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "3"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "62"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "4"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "6"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "6"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "7"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/cntlCONTAINER1_LAYO/shellcont/shell").selectedRows = "43"
session.findById("wnd[1]/usr/tabsG_TS_ALV/tabpALV_M_R1/ssubSUB_DYN0510:SAPLSKBH:0620/btnAPP_WL_SING").press
session.findById("wnd[1]/tbar[0]/btn[0]").press


'Remove subtotals
session.findById("wnd[0]/tbar[1]/btn[42]").press
session.findById("wnd[1]/usr/subSUB_DYN0500:SAPLSKBH:0610/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/subSUB_DYN0500:SAPLSKBH:0610/btnAPP_FL_SING").press
session.findById("wnd[1]/usr/subSUB_DYN0500:SAPLSKBH:0610/btnAPP_FL_SING").press
session.findById("wnd[1]/tbar[0]/btn[0]").press


'KSB1 copy in main workbook
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "10"
[COLOR=#FF0000]session.findById("wnd[1]/tbar[0]/btn[0]").press[/COLOR]


'Workbooks.Open Filename:=[Removed for security reasons]
Cells.Copy Destination:=MainWB.Worksheets("KSB1").Range("A1")
Workbooks("[Removed for security reasons]").Close
session.findById("wnd[0]/tbar[0]/btn[15]").press
session.findById("wnd[1]/usr/btnSPOP-OPTION1").press
session.findById("wnd[0]/tbar[0]/btn[15]").press


LastrowKSB1 = Worksheets("KSB1").Range("A" & Rows.count).End(xlUp).Row
wscount = Worksheets.count


'Match between the tab 'Foldermapping' and 'KSB1'
If Worksheets(Foldermapping).Range("D2").Value <> 0 Then
    If MsgBox([Removed for security reasons], vbYesNo + vbQuestion, "[Removed for security reasons]") = vbNo Then Exit Sub
End If


'Worksheet deletion
Do Until wscount <= 6
    wscount = Worksheets.count
    Worksheets(6).Delete
Loop


'ZACC
session.StartTransaction "ZACC"
session.findById("wnd[0]/usr/ctxt$ZLEDGER").Text = "[Removed for security reasons]"
session.findById("wnd[0]/usr/ctxt$ZVERBUD").Text = "1"
session.findById("wnd[0]/usr/ctxt$ZVERBU1").Text = "2"
session.findById("wnd[0]/usr/txt$ZEXERC").Text = Year
session.findById("wnd[0]/usr/txt$ZP1").Text = Per + 1
session.findById("wnd[0]/usr/ctxt$ZCOELEM").Text = "[Removed for security reasons]"
session.findById("wnd[0]/usr/btn%__ZCOELEM_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[16]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/usr/ctxt$ZCOCENT").Text = ""
session.findById("wnd[0]/usr/btn%__ZCOCENT_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[16]").press
Workbooks.Open vari
Range("A1:A" & LastrowFM - 4).Copy
session.findById("wnd[1]/tbar[0]/btn[24]").press
ActiveWorkbook.Close SaveChanges:=False
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[8]").press


On Error GoTo Navig
session.findById("wnd[0]/shellcont/shell/shellcont[2]/shell").selectedNode = "000001"
On Error GoTo 0


'Adjust columns size
session.findById("wnd[0]/usr/lbl[5,15]").SetFocus
session.findById("wnd[0]").sendVKey 18
session.findById("wnd[1]/usr/txtRGRWF-COLWD").Text = "5"
'session.findById("wnd[1]/usr/txtRGRWF-COLWD").caretPosition = 1
session.findById("wnd[1]/tbar[0]/btn[0]").press


'Collapse all


'Actual Per
session.findById("wnd[0]").sendVKey 2
'Actual YTD
session.findById("wnd[0]/usr/lbl[102,35]").caretPosition = 5
session.findById("wnd[0]").sendVKey 2
'Last Year Actual YTD
session.findById("wnd[0]/usr/lbl[102,35]").caretPosition = 6
session.findById("wnd[0]").sendVKey 2


session.findById("wnd[0]/usr/lbl[102,35]").caretPosition = 5
session.findById("wnd[0]").sendVKey 2


[A lot removed for security reasons]

On Error GoTo CloseT


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


On Error GoTo 0


Application.ScreenUpdating = True
Application.DisplayAlerts = True


MsgBox "All done!", vbInformation, "Process ran successfully!"


Exit Sub


'Error handlers


NotConnected:
    MsgBox "Please log into SAP first. This error might also appear if you have the following pop-up appearing in SAP:" _
    & " 'A script is trying to attach to the GUI'. To remove that pop-up, do the following:" & vbNewLine & vbNewLine _
    & "1. Press Alt+F12 in your SAP Home interface, then select 'Options';" & vbNewLine _
    & "2. On the Options window, select 'Accessibility & Scripting', then 'Scripting';" & vbNewLine _
    & "3. Uncheck the option 'Notify when a script attaches to SAP GUI', then click OK.", vbCritical, "Please log in!"


Exit Sub


Dateformat:
    MsgBox "Excel's date format and SAP's date format don't match! " _
    & "Please change your SAP date format with the following format: 'MM/DD/YYYY'." & vbNewLine & vbNewLine _
    & "To do so, please do the following:" & vbNewLine _
    & "1. Go to the '/nsu3' transaction (this is your user settings page);" & vbNewLine _
    & "2. Click the Defaults tab;" & vbNewLine _
    & "3. Choose the 'MM/DD/YYYY' option;" & vbNewLine _
    & "4. Click the Save button. Your selections will become effective the next time you log on to SAP;" & vbNewLine _
    & "5. Log out of SAP and relog into SAP. You will be able to rerun this macro afterwards.", vbCritical, "Incompatible date format!"


Exit Sub


Navig:


session.findById("wnd[0]/tbar[1]/btn[46]").press
session.findById("wnd[0]/shellcont/shell/shellcont[2]/shell").selectedNode = "000001"
Resume Next


CloseT:


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


MsgBox "All done!", vbInformation, "Process ran successfully!"


Exit Sub


End Sub


Also, I have a question. Are you running this from VBA or from VBS ?

I think I should be able to write code in VBA that invokes the Windows SaveAs dialog with the file name already filled in as well as to write code that hits the Save button programmatically .. I can show you an example but it will be up to you integrate the code with your existing VBA/VBS.

My main code is VBA and I'm trying to call a VB Script to manage the save as dialog box because when the red line occurs, VBA freeze all other process until the save or cancel button are pressed.

I'm starting to wonder if running a VB Script AND VBA macro is possible at the same time. I know I can't run two instances of VBA at once, so maybe VBA and VBS can't be handled simultaneously as well? In which case, I would be needing another language to manage that box.... How can a simple box be so complicated, I wonder....
 
Upvote 0
So you want to be able to fill in the filename with a predefined string and click save button programmatically when the Windows SaveAs dialog comes up in your code ?

What about the location of the save ?
 
Upvote 0
So you want to be able to fill in the filename with a predefined string and click save button programmatically when the Windows SaveAs dialog comes up in your code ?

What about the location of the save ?

Yup the predefined string and the location is basically the variable KSB1R14.
 
Upvote 0
Ok. I am about to leave the computer but I'll hopefully post some code later on .
 
Upvote 0
Here is an example that invokes the Windows SaveAs dialog, fills in the save file name and clicks the Save Button programmatically :

In a Standard Module :

Code:
Option Explicit 

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type
     
    Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private hHook As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
     
    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 hHook As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_HIDEREADONLY As Long = &H4

Private Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
    OFN_LONGNAMES Or _
    OFN_OVERWRITEPROMPT Or _
    OFN_HIDEREADONLY
    
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const BM_CLICK = &HF5

Private sWait As Single

Sub Test()

    Dim sDesktopPath As String
    Dim sIntitFileName As String
    Dim sFileName As String
    
    sDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sIntitFileName = IIf(Right(sDesktopPath, 1) = "", sDesktopPath & "test.txt", sDesktopPath & "\test.txt")
    
    sWait = Timer
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
    sFileName = BrowseForFileSave("Browse for a file", "Text Files (*.txt)" & vbNullChar & "*.txt", sIntitFileName)
    
    MsgBox "Save File Name Is: " & vbNewLine & sFileName
End Sub
 
 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Dim lRet As Long
    Dim sBuffer As String
    
    If Timer - sWait >= 5 Then UnhookWindowsHookEx hHook: Exit Function
    If idHook = HCBT_ACTIVATE Then
        sBuffer = Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "#32770" Then
            If FindWindowEx(wParam, 0, "DUIViewWndClassName", vbNullString) Then
                UnhookWindowsHookEx hHook
                Call PostMessage(GetDlgItem(wParam, 1), BM_CLICK, 0, ByVal 0)
            End If
        End If
    End If
    HookProc = CallNextHookEx(hHook, idHook, ByVal wParam, ByVal lParam)
End Function
 
Private Function BrowseForFileSave(strTitle As String, myFilter As String, strInitialFile As String) As String
    Dim i As Integer
    Dim OpenFile    As OPENFILENAME
    Dim lReturn     As Long
    Dim mySaveFile As String
 
    OpenFile.lpstrFilter = myFilter
    OpenFile.nFilterIndex = 1
    OpenFile.hwndOwner = 0
    OpenFile.lpstrFile = String(257, 0)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = LenB(OpenFile)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = Len(OpenFile)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
   
    If strInitialFile <> "" Then
        i = InStrRev(strInitialFile, "")
        If i > 0 Then
            OpenFile.lpstrInitialDir = Left(strInitialFile, i - 1)
            mySaveFile = Mid(strInitialFile, i + 1)
            OpenFile.lpstrFile = mySaveFile & String(257 - Len(mySaveFile), 0)
        End If
    End If
 
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = OFS_FILE_SAVE_FLAGS
    lReturn = GetSaveFileName(OpenFile)
 
    If lReturn = 0 Then
        BrowseForFileSave = ""
    Else
        BrowseForFileSave = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    End If
 
End Function

Now in your case, I guess you would do the following:

1- Add this at the top of your existing module where you have your code:

Code:
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
     
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private hHook As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 hHook As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const BM_CLICK = &HF5

Private sWait As Single

Sub SetHook()

    sWait = Timer
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)

End Sub

 [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Dim lRet As Long
    Dim sBuffer As String
    
    If Timer - sWait >= 5 Then UnhookWindowsHookEx hHook: Exit Function
    If idHook = HCBT_ACTIVATE Then
        sBuffer = Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "#32770" Then
            If FindWindowEx(wParam, 0, "DUIViewWndClassName", vbNullString) Then
                UnhookWindowsHookEx hHook
                Call PostMessage(GetDlgItem(wParam, 1), BM_CLICK, 0, ByVal 0)
            End If
        End If
    End If
    HookProc = CallNextHookEx(hHook, idHook, ByVal wParam, ByVal lParam)
End Function

2- Add this to you existing [Removed for security reasons]() routine right before the line :

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

somethig like this :

Code:
[COLOR=#008000]'KSB1 copy in main workbook[/COLOR]
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "10"
[COLOR=#0000ff][B]Call SetHook[/B][/COLOR]
[COLOR=#ff0000]session.findById("wnd[1]/tbar[0]/btn[0]").press[/COLOR]

I hope it works for you.
 
Upvote 0
Here is an example that invokes the Windows SaveAs dialog, fills in the save file name and clicks the Save Button programmatically :

In a Standard Module :

Code:
Option Explicit 

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type
     
    Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private hHook As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
     
    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 hHook As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_HIDEREADONLY As Long = &H4

Private Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
    OFN_LONGNAMES Or _
    OFN_OVERWRITEPROMPT Or _
    OFN_HIDEREADONLY
    
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const BM_CLICK = &HF5

Private sWait As Single

Sub Test()

    Dim sDesktopPath As String
    Dim sIntitFileName As String
    Dim sFileName As String
    
    sDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sIntitFileName = IIf(Right(sDesktopPath, 1) = "", sDesktopPath & "test.txt", sDesktopPath & "\test.txt")
    
    sWait = Timer
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
    sFileName = BrowseForFileSave("Browse for a file", "Text Files (*.txt)" & vbNullChar & "*.txt", sIntitFileName)
    
    MsgBox "Save File Name Is: " & vbNewLine & sFileName
End Sub
 
 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    Dim lRet As Long
    Dim sBuffer As String
    
    If Timer - sWait >= 5 Then UnhookWindowsHookEx hHook: Exit Function
    If idHook = HCBT_ACTIVATE Then
        sBuffer = Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "#32770" Then
            If FindWindowEx(wParam, 0, "DUIViewWndClassName", vbNullString) Then
                UnhookWindowsHookEx hHook
                Call PostMessage(GetDlgItem(wParam, 1), BM_CLICK, 0, ByVal 0)
            End If
        End If
    End If
    HookProc = CallNextHookEx(hHook, idHook, ByVal wParam, ByVal lParam)
End Function
 
Private Function BrowseForFileSave(strTitle As String, myFilter As String, strInitialFile As String) As String
    Dim i As Integer
    Dim OpenFile    As OPENFILENAME
    Dim lReturn     As Long
    Dim mySaveFile As String
 
    OpenFile.lpstrFilter = myFilter
    OpenFile.nFilterIndex = 1
    OpenFile.hwndOwner = 0
    OpenFile.lpstrFile = String(257, 0)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = LenB(OpenFile)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = Len(OpenFile)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
   
    If strInitialFile <> "" Then
        i = InStrRev(strInitialFile, "")
        If i > 0 Then
            OpenFile.lpstrInitialDir = Left(strInitialFile, i - 1)
            mySaveFile = Mid(strInitialFile, i + 1)
            OpenFile.lpstrFile = mySaveFile & String(257 - Len(mySaveFile), 0)
        End If
    End If
 
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = OFS_FILE_SAVE_FLAGS
    lReturn = GetSaveFileName(OpenFile)
 
    If lReturn = 0 Then
        BrowseForFileSave = ""
    Else
        BrowseForFileSave = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    End If
 
End Function

Now in your case, I guess you would do the following:

1- Add this at the top of your existing module where you have your code:

Code:
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
     
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private hHook As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 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 hHook As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const BM_CLICK = &HF5

Private sWait As Single

Sub SetHook()

    sWait = Timer
    hHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)

End Sub

 [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
   Private Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    Dim lRet As Long
    Dim sBuffer As String
    
    If Timer - sWait >= 5 Then UnhookWindowsHookEx hHook: Exit Function
    If idHook = HCBT_ACTIVATE Then
        sBuffer = Space(256)
        lRet = GetClassName(wParam, sBuffer, 256)
        If Left(sBuffer, lRet) = "#32770" Then
            If FindWindowEx(wParam, 0, "DUIViewWndClassName", vbNullString) Then
                UnhookWindowsHookEx hHook
                Call PostMessage(GetDlgItem(wParam, 1), BM_CLICK, 0, ByVal 0)
            End If
        End If
    End If
    HookProc = CallNextHookEx(hHook, idHook, ByVal wParam, ByVal lParam)
End Function

2- Add this to you existing [Removed for security reasons]() routine right before the line :

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

somethig like this :

Code:
[COLOR=#008000]'KSB1 copy in main workbook[/COLOR]
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "10"
[COLOR=#0000ff][B]Call SetHook[/B][/COLOR]
[COLOR=#ff0000]session.findById("wnd[1]/tbar[0]/btn[0]").press[/COLOR]

I hope it works for you.

Unfortunately, it doesn't :/

VBA still is waiting for me to push the save or cancel button from the SaveAs Dialog box.

Also, I don't see anywhere in the "#1" part the reference to the variable KSB1R14?
 
Upvote 0
All the code does is detect the SaveAs dialog as soon as it comes up and hit the Save Button.

Try commenting out the 4th If line and see what you get :

'If FindWindowEx(wParam, 0, "DUIViewWndClassName", vbNullString) Then

'End If

Leave the two lines between them ie: UnhookWindowsHookEx and PostMessage.
 
Upvote 0

Forum statistics

Threads
1,224,809
Messages
6,181,076
Members
453,020
Latest member
mattg2448

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top