Tackle the 'Not responding application outside of Microsoft Access' error in the calling A-CodePudding

I am using the ScriptControl in Access VBA to load the scripts (.vbs files) and execute them for extracting data from a SAP system. For the small data the code works fine.

However, when there is a big data which takes time or stops responding then Access opens a popup window asking me to switch to the app or retry. If I click on retry button or by hand switch to that window, then the script resumes!

Is there any way to tackle this access popup window or a code to press this retry button? Thanks

Mycode:

Open scriptPath For Input As #1
    vbsCode = Input$(LOF(1), 1)
    Close #1
    
    On Error GoTo ERR_VBS
    
    With CreateObject("ScriptControl")
        .Language = "VBScript"
        .AddCode vbsCode    '>>>>>>>>>>>>>>>> I get this popup window at this line

    End With

Tried :

Sub Test()
    
    Dim oSC As Object
    
    Set oSC = CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    
    CreateObjectx86 Empty ' close mshta host window at the end
    
End Sub

Function CreateObjectx86(sProgID)
   
    Static oWnd As Object
    Dim bRunning As Boolean
    Dim vbsCode As String, result As Variant, Script As Object
    
    Open "\My Documents\\Desktop\x.vbs" For Input As #1
    vbsCode = Input$(LOF(1), 1)
    Close #1
    
   
            Set oWnd = CreateWindow()
            oWnd.execScript vbsCode, "VBScript"  '>>>>>>>>>Gets an Error says "Error on Script page"
            Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
   
    
End Function

Function CreateWindow()

    ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
    Dim sSignature, oShellWnd, oProc
    
    On Error Resume Next
    Do Until Len(sSignature) = 32
        sSignature = sSignature & Hex(Int(Rnd * 16))
    Loop
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe about:""<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, False
    Do
        For Each oShellWnd In CreateObject("Shell.Application").Windows
            Set CreateWindow = oShellWnd.GetProperty(sSignature)
            If Err.Number = 0 Then Exit Function
            Err.Clear
        Next
    Loop
    
End Function

CodePudding user response：

So after lot of headache, I found the solution! The solution is to use waitToReturn. This will make Access VBA wait for the Script to be completed no matter how long it take! Hence, this tackled the problem of Access popup window asking to switch to window or Retry!

Solution code:

Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1 
Dim errorCode As Integer

errorCode = wsh.Run("C:\path\x.vbs", windowStyle, waitOnReturn)

If errorCode = 0 Then
    MsgBox "Script successful. "
Else
    MsgBox "Script exited with error code " & errorCode & "."
End If

CodePudding user response：

with cases like this you would always try to get the focus via the object you are manipulating, usually it is done by .setFocus or .active. the below is code that will help you out. I would try the session.setFocus.

Session.ActiveWindow.SetFocus

the below code will also help:
    Dim SapGuiAuto As Object
Dim Application As SAPFEWSELib.GuiApplication
Dim Connection As SAPFEWSELib.GuiConnection
Dim Session As SAPFEWSELib.GuiSession
Dim UserArea As SAPFEWSELib.GuiUserArea
' Dim oWindow As SAPFEWSELib.GuiConnection
Dim oUserAreaOfMobileWindow  As SAPFEWSELib.GuiUserArea
Dim oGuiSimpleContainer As SAPFEWSELib.GuiSimpleContainer

Set SapGuiAuto = GetObject("SAPGUI")

If Not IsObject(SapGuiAuto) Then
    Exit Sub
End If

Set Application = SapGuiAuto.GetScriptingEngine()

If Not IsObject(Application) Then
    Exit Sub
End If

Set Connection = Application.Connections(0)

If Not IsObject(Connection) Then
    Exit Sub
End If

Set Session = Connection.Sessions(0)
If Not IsObject(Session) Then
    Exit Sub
End If