让 ScriptControl 与 Excel 2010 x64 一起工作 [英] Getting ScriptControl to work with Excel 2010 x64

查看：19
本文介绍了让 ScriptControl 与 Excel 2010 x64 一起工作的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试使用

您还必须在代码末尾通过 CreateObjectx86 Empty 关闭该 HTA 窗口.

更新

您可以使宿主窗口自动关闭:通过创建类实例或 mshta 主动跟踪.

第一种方法假设您创建一个类实例作为包装器，它使用 Private Sub Class_Terminate() 来关闭窗口.

注意:如果 Excel 在代码执行时崩溃，则不会终止类，因此窗口将保持在后台.

将下面的代码放在一个名为cMSHTAx86Host的类模块中:

 选项显式私有对象作为对象私有子类_Initialize()#如果 Win64 则设置 oWnd = CreateWindow()oWnd.execScript Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", VBScript"#万一结束子私有函数 CreateWindow()' 来源 http://forum.script-coding.com/viewtopic.php?pid=75356#p75356Dim sSignature、oShellWnd、oProc出错时继续下一步直到 Len(sSignature) = 32sSignature = sSignature &十六进制(整数(Rnd * 16))环形CreateObject("WScript.Shell>).Run "%systemroot%syswow64mshta.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 值=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>">>0，假做对于 CreateObject(Shell.Application").Windows 中的每个 oShellWnd设置 CreateWindow = oShellWnd.GetProperty(sSignature)If Err.Number = 0 Then Exit Function错误清除下一个环形结束功能函数 CreateObjectx86(sProgID)#如果 Win64 则If InStr(TypeName(oWnd), "HTMLWindow") = 0 Then Class_Initialize设置 CreateObjectx86 = oWnd.CreateObjectx86(sProgID)#别的设置 CreateObjectx86 = CreateObject(sProgID)#万一结束功能函数退出()#如果 Win64 则If InStr(TypeName(oWnd), "HTMLWindow") >0 然后 oWnd.Close#万一结束功能私有子类_Terminate()退出结束子

将以下代码放入标准模块中:

选项显式子测试()Dim oHost 作为新的 cMSHTAx86Host将 osC 调暗为对象Set oSC = oHost.CreateObjectx86("ScriptControl") ' 通过 x86 mshta 主机创建 ActiveXDebug.Print TypeName(oSC) ' ScriptControl'做一些事情' mshta 窗口一直运行直到 oHost 实例存在' 如有必要，您可以通过 oHost.Quit 手动关闭 mshta 主机窗口结束子

第二种方法适用于那些出于某种原因不想使用类的人.关键是 mshta 窗口每 500 毫秒通过内部 setInterval() 函数检查 VBA 的 Static oWnd 变量调用 CreateObjectx86 变量的状态，并且如果引用丢失(用户在 VBA 项目窗口中按下了重置，或者工作簿已关闭(错误 1004))，则退出.

注意:VBA 断点(错误 57097)、用户编辑的工作表单元格、打开的对话框模式窗口(如打开/保存/选项)(错误 -2147418111)将暂停跟踪，因为它们会使应用程序对来自 mshta 的外部调用无响应.此类动作异常处理，完成后代码将继续工作，不会崩溃.

将以下代码放入标准模块中:

选项显式子测试()将 osC 调暗为对象Set oSC = CreateObjectx86("ScriptControl") ' 通过 x86 mshta 主机创建 ActiveXDebug.Print TypeName(oSC) ' ScriptControl'做一些事情' mshta 窗口一直运行直到对窗口的静态 oWnd 引用丢失' 如有必要，您可以通过 CreateObjectx86 Empty 手动关闭 mshta 主机窗口结束子函数 CreateObjectx86(可选 sProgID)静态对象作为对象Dim bRunning As Boolean#如果 Win64 则bRunning = InStr(TypeName(oWnd), "HTMLWindow") >0选择案例真案例缺失(sProgID)If bRunning Then oWnd.Lost = False退出函数Case IsEmpty(sProgID)If bRunning Then oWnd.Close退出函数案例未运行设置 oWnd = CreateWindow()oWnd.execScript Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", VBScript"oWnd.execScript "var Lost, App;": 设置 oWnd.App = ApplicationoWnd.execScript "Sub Check(): On Error Resume Next: Lost = True: App.Run("""CreateObjectx86"""): If Lost And (Err.Number = 1004 Or Err.Number = 0) Thenclose: End If End Sub"、VBScript"oWnd.execScriptsetInterval('Check();', 500);"结束选择设置 CreateObjectx86 = oWnd.CreateObjectx86(sProgID)#别的设置 CreateObjectx86 = CreateObject(sProgID)#万一结束功能函数创建窗口()' 来源 http://forum.script-coding.com/viewtopic.php?pid=75356#p75356Dim sSignature、oShellWnd、oProc出错时继续下一步直到 Len(sSignature) = 32sSignature = sSignature &十六进制(整数(Rnd * 16))环形CreateObject("WScript.Shell>).Run "%systemroot%syswow64mshta.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 值=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>">>0，假做对于 CreateObject(Shell.Application").Windows 中的每个 oShellWnd设置 CreateWindow = oShellWnd.GetProperty(sSignature)If Err.Number = 0 Then Exit Function错误清除下一个环形结束功能

更新 2

由于注意到权限问题而拒绝了 Scriptlet.TypeLib.

I am trying to use the solution given to this, however, whenever I try to run the most basic anything, I get an Object not Defined error. I thought this would be my fault (not having installed ScriptControl). However, I tried installing as described in here, to no avail.

I am running Windows 7 Professional x64 with Office 2010 64 bit.

解决方案

You can create ActiveX objects like ScriptControl, which available on 32-bit Office versions via mshta x86 host on 64-bit VBA version, here is the example (put the code in a standard VBA project module):

Option Explicit

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
    
    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        If IsEmpty(sProgID) Then
            If bRunning Then oWnd.Close
            Exit Function
        End If
        If Not bRunning Then
            Set oWnd = CreateWindow()
            oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"
        End If
        Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
    #Else
        If Not IsEmpty(sProgID) Then Set CreateObjectx86 = CreateObject(sProgID)
    #End If
    
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%syswow64mshta.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

It has few shortcomings: the separate mshta.exe process running is necessary, which is listed in task manager, and pressing Alt+Tab hidden HTA window is shown:

Also you have to close that HTA window at the end of your code by CreateObjectx86 Empty.

UPDATE

You can make the host window to be closed automatically: by creating class instance or mshta active tracing.

First method assumes you create a class instance as a wrapper, which uses Private Sub Class_Terminate() to close the window.

Note: if Excel crashes while code execution then there is no class termination, so the window will stay in background.

Put the below code in a class module named cMSHTAx86Host:

    Option Explicit
    
    Private oWnd As Object
    
    Private Sub Class_Initialize()
        
        #If Win64 Then
            Set oWnd = CreateWindow()
            oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", "VBScript"
        #End If
        
    End Sub
    
    Private 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%syswow64mshta.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

    Function CreateObjectx86(sProgID)
       
        #If Win64 Then
            If InStr(TypeName(oWnd), "HTMLWindow") = 0 Then Class_Initialize
            Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
        #Else
            Set CreateObjectx86 = CreateObject(sProgID)
        #End If
        
    End Function
    
    Function Quit()
       
        #If Win64 Then
            If InStr(TypeName(oWnd), "HTMLWindow") > 0 Then oWnd.Close
        #End If
        
    End Function
    
    Private Sub Class_Terminate()
    
       Quit
        
    End Sub

Put the below code in a standard module:

Option Explicit

Sub Test()
    
    Dim oHost As New cMSHTAx86Host
    Dim oSC As Object
    
    Set oSC = oHost.CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    
    ' mshta window is running until oHost instance exists
    ' if necessary you can manually close mshta host window by oHost.Quit
    
End Sub

Second method for those who don't want to use classes for some reason. The point is that mshta window checks the state of VBA's Static oWnd variable calling CreateObjectx86 without argument via internal setInterval() function each 500 msec, and quits if the reference lost (either user have pressed Reset in VBA Project window, or the workbook has been closed (error 1004)).

Note: VBA breakpoints (error 57097), worksheet cells edited by user, opened dialog modal windows like Open / Save / Options (error -2147418111) will suspend the tracing since they makes application unresponsive for external calls from mshta. Such actions exceptions are handled, and after completion the code will continue to work, no crashes.

Put the below code in a standard module:

Option Explicit

Sub Test()
    
    Dim oSC As Object
    
    Set oSC = CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff
    
    ' mshta window is running until Static oWnd reference to window lost
    ' if necessary you can manually close mshta host window by CreateObjectx86 Empty
    
End Sub

Function CreateObjectx86(Optional sProgID)
   
    Static oWnd As Object
    Dim bRunning As Boolean
    
    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        Select Case True
            Case IsMissing(sProgID)
                If bRunning Then oWnd.Lost = False
                Exit Function
            Case IsEmpty(sProgID)
                If bRunning Then oWnd.Close
                Exit Function
            Case Not bRunning
                Set oWnd = CreateWindow()
                oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID) End Function", "VBScript"
                oWnd.execScript "var Lost, App;": Set oWnd.App = Application
                oWnd.execScript "Sub Check(): On Error Resume Next: Lost = True: App.Run(""CreateObjectx86""): If Lost And (Err.Number = 1004 Or Err.Number = 0) Then close: End If End Sub", "VBScript"
                oWnd.execScript "setInterval('Check();', 500);"
        End Select
        Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
    #Else
        Set CreateObjectx86 = CreateObject(sProgID)
    #End If
    
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%syswow64mshta.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

UPDATE 2

Refused Scriptlet.TypeLib due to due to noticed permission issues.

这篇关于让 ScriptControl 与 Excel 2010 x64 一起工作的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆