让 ScriptControl 与 Excel 2010 x64 一起工作

Posted 2023-03-29

技术标签:

【中文标题】让 ScriptControl 与 Excel 2010 x64 一起工作【英文标题】：Getting ScriptControl to work with Excel 2010 x64 【发布时间】：2012-04-01 07:46:46 【问题描述】：

我正在尝试使用this 提供的解决方案，但是，每当我尝试运行最基本的任何东西时，都会收到Object not Defined 错误。我认为这是我的错（没有安装 ScriptControl）。但是，我尝试按照here 中的说明进行安装，但无济于事。

我正在运行带有 Office 2010 64 位的 Windows 7 Professional x64。

【问题讨论】：

为了有用，我们需要查看您尝试过的确切代码，以及出现错误（以及来自代码的哪一行）蒂姆 - 我也有同样的问题。我正在使用 Codo 接受的链接问题答案中的确切代码（从这个问题的第一行链接）。运行 TestJSONAccess 子程序时，我从 InitScriptEngine 子程序的第一行（Set ScriptEnging = New ScriptControl）收到一条错误消息“运行时错误'429'：ActiveX 组件无法创建对象”。我已经设置了对 msscript.ocx 文件的引用。 【参考方案1】：

您可以通过 64 位 VBA 版本的 mshta x86 主机在 32 位 Office 版本上创建 ActiveX 对象，例如 ScriptControl，这是示例（将代码放在标准 VBA 项目模块中）：

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%\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

它有一些缺点：需要单独运行mshta.exe进程，在任务管理器中列出，按Alt+Tab显示隐藏HTA窗口：

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

更新

您可以使主机窗口自动关闭：通过创建类实例或 mshta 主动跟踪。

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

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

将下面的代码放在一个名为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%\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

    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

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

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

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

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

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

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%\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

更新 2

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

【讨论】：

惊人的解决方案，应该是公认的答案，你认为有没有办法在宏结束时自动关闭窗口？ @gbaccetta 我发布了窗口自动关闭的解决方案。 @omegastripes 谢谢你，我会在我回到那个项目的工作后尽快尝试，但从它的外观来看，它应该像一个魅力这应该是公认的答案，就像魅力一样 @SlowLearner 该问题是由不正确的属性名称引起的。 oWnd.App 可以，oWnd.app 不行。【参考方案2】：

对于 32 位版本的控件，可提供 64 位替换。 Google for Tabalacus 脚本控制。 https://github.com/tablacus/TablacusScriptControl。如果需要，可以使用免费的 VS 版本编译控件。

【讨论】：

这很有魅力，应该是公认的答案！ :) 是的，知道它很容易 :) TablacusScriptControl 在 2013 年以后的 64 位 Office 中不起作用。它甚至没有出现在“工具”->“参考”对话框中。这是在 2018 年 7 月向他们报告的，他们的反应非常令人沮丧和悲伤：Unfortunately, I don't have Excel 2016 and I'm not very familiar with Excel. 也为我工作（64 位 Office 2016）【参考方案3】：

遗憾的是，scriptcontrol 只是一个 32 位组件，不会在 64 位进程中运行。

【讨论】：

以上是关于让 ScriptControl 与 Excel 2010 x64 一起工作的主要内容，如果未能解决你的问题，请参考以下文章

在 Excel VBA 代码中处理 XMLHttp 响应中的 JSON 对象

VBA研究64位系统下无法用ScriptControl控件解析JSon数据

如何让 Excel 加载项 (Excel 2007) 中的用户定义函数与自动完成功能一起使用？

如何合并两个excel中的指定数据？如何让2个excel窗口同时在前台显示？

excel单元格编号有字母有数字怎么让后面的数字增加，

如何让两台电脑的Excel同步工作？