Applications blocks Subroutine from continuing

amarokWPcom

New Member
Joined
May 30, 2019
Messages
26
I want to automatize the following procedure:

I want to attach an email after sending it to a document in SAP, but as soon as the "select Files:" windows appear my code is blocked from continuing bc this window belongs not to the SAP application itself (I don't know if these are the correct words).

I have the complete code running well, for sending the email, finding the email after in the outbox, and saving the email in a local folder.
I modified also SAP, to show by default this local folder path for up- and downloads.

In side SAP it looks like this:
The green box shows the filed in which the filename has to be. Attention: The upload works NOT if I set the filename already here!

2020-02-01_07-43-18.png


I have to click in the field and press the appearing button on the right side of the field:

2020-02-01_07-43-44.png


After pressing the button the "Select Files:" Window appears in which I would have to paste the clipboard which works only manually, unfortunately not with the shown code.

2020-02-01_07-44-05.png


I have the code running to start the process and open this window, but then it gets blocked:

VBA Code:
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function SendMessageByString Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Integer) As Integer
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer


Sub attach_tool()

On Error GoTo eh

Shell "wscript.exe ""C:\Users\thxxxx\Documents\Professional_RS_AOF\tools\continue.vbs"""

    Application.DisplayAlerts = False

    Dim str_path_tool As String
    str_path_tool = ActiveWorkbook.Worksheets("PARAMETER").Cells(61, 4)

    Dim str_filename_tool As String
    str_filename_tool = ActiveWorkbook.Worksheets("PARAMETER").Cells(16, 4)
    
    Dim str_user_attachfolder As String
    str_user_attachfolder = ActiveWorkbook.Worksheets("PARAMETER").Cells(19, 4)
    
    Dim str_path_be As String
    str_path_be = ActiveWorkbook.Worksheets("PARAMETER").Cells(30, 4)
    
    Dim W_BPNumber As String
    W_BPNumber = Workbooks(str_filename_tool).Worksheets("DCO_ADVISE").Range("A11").Value
      
    Call copy_lastmail_msg
    
    If Not IsObject(SAPGuiApp) Then
        Set SapGuiAuto1 = GetObject("SAPGUI")
        Set SAPGuiApp = SapGuiAuto1.GetScriptingEngine
    End If
    If Not IsObject(Connection) Then
        Set Connection = SAPGuiApp.Children(0)
    End If
    If Not IsObject(SAP_session) Then
        Set SAP_session = Connection.Children(3)
    End If
    If IsObject(WScript1) Then
        WScript1.ConnectObject SAP_session, "on"
        WScript1.ConnectObject SAPGuiApp, "on"
    End If

    SAP_session.findById("wnd[0]").Maximize
 
    SAP_session.findById("wnd[0]/tbar[0]/okcd").Text = "/nZSD_MASS_ATTACH"
    SAP_session.findById("wnd[0]").sendVKey 0
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtS_BANFN-LOW").Text = W_BPNumber
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/chkP_BANFN").Selected = True
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtS_BANFN-LOW").SetFocus
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtS_BANFN-LOW").caretPosition = 10
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtP_FILES").SetFocus
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtP_FILES").caretPosition = 0
    SAP_session.findById("wnd[0]").sendVKey 4
    
    


    SAP_session.findById("wnd[0]/tbar[1]/btn[8]").Press
    SAP_session.findById("wnd[1]/usr/btnBUTTON_1").Press
    SAP_session.findById("wnd[1]/tbar[0]/btn[0]").Press
    SAP_session.findById("wnd[0]/tbar[0]/btn[11]").Press
    SAP_session.findById("wnd[0]").sendVKey 3
    SAP_session.findById("wnd[1]/usr/btnBUTTON_1").Press

done:
    Exit Sub
eh:
    RaiseError Err.Number, Err.Source, "aa_single_mail_attach.attach_tool", Err.Description, Erl

End Sub
In the line "Call copy_lastmail_msg" the code gets the name of the file to be attached in the clipboard.
In the line " SAP_session.findById("wnd[0]").sendVKey 4" the "Select Files:" window opens, which blocks the code from continuing.

My first solution was to start a vbscript, as you can see in line "Shell "wscript.exe ""C:\Users\thxxxx\Documents\Professional_RS_AOF\tools\continue.vbs"""

The code of this file looks like this:

VBA Code:
Set wshShell = CreateObject("WScript.Shell")

Do
    ret = wshShell.AppActivate("Select Files:") 
Loop until ret = True 


WScript.Sleep 500

ret = wshShell.AppActivate("Select Files:") 

if ret = True then

    ret = wshShell.AppActivate("Select Files:") 

    WScript.Sleep 500

    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    wshShell.Sendkeys "TAB", True
    WScript.Sleep 500
    
    wshShell.Sendkeys "^v", True

    WScript.Sleep 10000

    wshShell.Sendkeys "{ENTER}", True
   "
End if
This finds the "Select Files:" window goes after pressing "tab" 12 times in the "Dateiname" cell where the filename has to be pasted but the send key of STRG-V doesn't work. If I press STRG-V by hand, he sets the name immediately and continues with wshShell.Sendkeys "{ENTER}", True which closes the "Select Files:" and the code from the top continues without problems. Several kinds of SendKEys are working but not the direct paste from the clipboard :(

If the "Select Files: " would be already open before the Subroutine starts this code works perfectly to do the job:

VBA Code:
Sub set_mail_upload_name()


'On Error GoTo eh

'Find Mass Attach Window

'Find Shell Window Button

    Do
    DoEvents

        hwindow2 = FindWindow(vbNullString, "Select Files:")

    Loop Until hwindow2 > 0

    file_name_box = FindWindowEx(hwindow2, 0&, "ComboBoxEx32", vbNullString)
    ok_button = FindWindowEx(hwindow2, 0&, "Button", "Ö&ffnen")
    folder_window = FindWindowEx(hwindow2, 0&, "Shell Window Class", vbNullString)

    
    file_name = Workbooks(str_filename_tool).Sheets("DCO_ADVISE").Range("G11").Value
   
    
    Call SendMessageByString(file_name_box, WM_SETTEXT, 0, file_name)
    Call SendMessage(ok_button, BM_CLICK, 0, ByVal 0&)

End Sub

  1. How could I fix the first solution, that my vbscript sets the vaiable (filename) in the "Dateiname" field?

    Or
  2. Maybe I should got the other way and let the vbscript open the "Select Files:" and after this the Subroutine which is working already well starts (bc this is working as I wrote IF the "Select Files:" is already open).
Many thanks in advance for your feedback!
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

amarokWPcom

New Member
Joined
May 30, 2019
Messages
26
Solved after several hours....

VBA Code:
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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 Long
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, _
    ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As LongPtr
    
    Public Const BM_CLICK = &HF5
    Public Const WM_SETTEXT = &HC


Sub attach_tool()

On Error GoTo eh

    Application.DisplayAlerts = False

    Dim str_path_tool As String
    str_path_tool = ActiveWorkbook.Worksheets("PARAMETER").Cells(61, 4)

    Dim str_filename_tool As String
    str_filename_tool = ActiveWorkbook.Worksheets("PARAMETER").Cells(16, 4)
    
    Dim str_user_attachfolder As String
    str_user_attachfolder = ActiveWorkbook.Worksheets("PARAMETER").Cells(19, 4)
    
    Dim str_path_be As String
    str_path_be = ActiveWorkbook.Worksheets("PARAMETER").Cells(30, 4)
    
    Dim W_BPNumber As String
    W_BPNumber = Workbooks(str_filename_tool).Worksheets("DCO_ADVISE").Range("A11").Value
          
    If Not IsObject(SAPGuiApp) Then
        Set SapGuiAuto1 = GetObject("SAPGUI")
        Set SAPGuiApp = SapGuiAuto1.GetScriptingEngine
    End If
    If Not IsObject(Connection) Then
        Set Connection = SAPGuiApp.Children(0)
    End If
    If Not IsObject(SAP_session) Then
        Set SAP_session = Connection.Children(3)
    End If
    If IsObject(WScript1) Then
        WScript1.ConnectObject SAP_session, "on"
        WScript1.ConnectObject SAPGuiApp, "on"
    End If

    SAP_session.findById("wnd[0]").Maximize

    SAP_session.findById("wnd[0]/tbar[0]/okcd").Text = "/nZSD_MASS_ATTACH"
    SAP_session.findById("wnd[0]").sendVKey 0
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtS_BANFN-LOW").Text = W_BPNumber
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/chkP_BANFN").Selected = True
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtS_BANFN-LOW").SetFocus

    Shell "wscript.exe ""C:\Users\th61a3\Documents\Professional_RS_AOF\tools\continue3.vbs"""

    Call set_mail_upload_name
    
    SAP_session.findById("wnd[0]/tbar[1]/btn[8]").Press
    SAP_session.findById("wnd[1]/usr/btnBUTTON_1").Press
    SAP_session.findById("wnd[1]/tbar[0]/btn[0]").Press
    SAP_session.findById("wnd[0]/tbar[0]/btn[11]").Press
    SAP_session.findById("wnd[0]").sendVKey 3
    SAP_session.findById("wnd[1]/usr/btnBUTTON_1").Press

done:
    Exit Sub
eh:
    RaiseError Err.Number, Err.Source, "aa_single_mail_attach.attach_tool", Err.Description, Erl

End Sub


Sub set_mail_upload_name()

    On Error GoTo eh
    
    Dim str_filename_tool As String
    str_filename_tool = ActiveWorkbook.Worksheets("PARAMETER").Cells(16, 4)
    
    Do
    DoEvents
    
        hwindow2 = FindWindow(vbNullString, "Select Files:")
    
    Loop Until hwindow2 > 0
    
    file_name_box = FindWindowEx(hwindow2, 0&, "ComboBoxEx32", vbNullString)
    ok_button = FindWindowEx(hwindow2, 0&, "Button", "Ö&ffnen")

    Dim file_name As String
    file_name = Workbooks(str_filename_tool).Worksheets("DCO_ADVISE").Range("G11").Value

    Call SendMessageByString(file_name_box, WM_SETTEXT, 0, file_name)
    Call SendMessage(ok_button, BM_CLICK, 0, ByVal 0&)

done:
    Exit Sub
eh:
    RaiseError Err.Number, Err.Source, "aa_single_mail_attach.set_mail_upload_name", Err.Description, Erl

End Sub
The vbscript "continue3..." :
VBA Code:
   If Not IsObject(SAPGuiApp) Then
        Set SapGuiAuto1 = GetObject("SAPGUI")
        Set SAPGuiApp = SapGuiAuto1.GetScriptingEngine
    End If
    If Not IsObject(Connection) Then
        Set Connection = SAPGuiApp.Children(0)
    End If
    If Not IsObject(SAP_session) Then
        Set SAP_session = Connection.Children(3)
    End Ifa
    If IsObject(WScript1) Then
        WScript1.ConnectObject SAP_session, "on"
        WScript1.ConnectObject SAPGuiApp, "on"
    End If

    SAP_session.findById("wnd[0]").Maximize
 
   
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtP_FILES").SetFocus
    SAP_session.findById("wnd[0]/usr/subSUB_SCREEN:ZPCZZZ_ATTACH_DOC_TO_OBJECTS:1001/ctxtP_FILES").caretPosition = 0
    SAP_session.findById("wnd[0]").sendVKey 4
 

Watch MrExcel Video

Forum statistics

Threads
1,099,368
Messages
5,468,213
Members
406,573
Latest member
nasirpm

This Week's Hot Topics

Top