logo标签列表

使ScriptControl与Excel 2010 x64配合使用

vbaexcelcomexcel-2010scriptcontrol
12

我正在尝试使用这里提供的解决方案，但是无论我运行什么最基本的东西，都会出现对象未定义的错误。我认为这可能是我的问题（没有安装ScriptControl）。然而，我按照这里所述进行了安装，但没有成功。

我正在运行Windows 7 Professional x64和Office 2010 64位版本。

为了更有帮助，我们需要看到您尝试的确切代码以及出现的错误（以及来自哪行代码）。 - Tim Williams
Tim - 我也遇到了同样的问题。我正在使用从此问题的顶部链接的Codo的被接受答案中的确切代码。当运行TestJSONAccess子程序时，我会收到一个错误，说“运行时错误'429'：ActiveX组件无法创建对象”，来自InitScriptEngine子程序的第一行（Set ScriptEnging = New ScriptControl）。我已经设置了对msscript.ocx文件的引用。 - Kevin Pope
3个回答
31

您可以创建像ScriptControl这样的ActiveX对象，在64位VBA版本上通过mshta x86主机在32位Office版本上使用，这里是一个示例（将代码放入标准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窗口:
enter image description here
此外，您必须通过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窗口通过内部的setInterval()函数每500毫秒调用CreateObjectx86来检查VBA的Static oWnd变量的状态，并在引用丢失（无论是用户按下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
1
@gbaccetta，我已经发布了窗口自动关闭的解决方案。 - omegastripes
这个（修订后的标准模块方法）整整一天都运行得很好，包括今天早上。然后，出于无法理解的原因，它在这里开始出错：oWnd.execScript "var Lost, App;": Set oWnd.App = Application 在这一部分的 Set oWnd.App = Application。我把有问题的代码移到了 setInterval... 之后，现在似乎又可以工作了。你有什么想法，这行代码是否必要？否则非常棒 :) - SlowLearner
2
这应该是被接受的答案，能够完美地工作。 - Alejandro Cumpa
1
@SlowLearner 问题是由于属性名称不正确引起的。oWnd.App 是正确的，oWnd.app 不行。 - omegastripes
显示剩余7条评论
5
2
这个方法非常有效，应该被采纳为最佳答案！ - Daniel Widdis
是的，我知道使用它非常容易 :) - Thomas Ludewig
TablacusScriptControl在2013年之后的64位Office中无法使用。它甚至不会出现在“工具”->“引用”对话框中。这在2018年7月向他们报告过，但他们的回应非常令人沮丧和悲伤：很遗憾，我没有Excel 2016，也不太熟悉Excel。 - Excel Hero
对我也起作用了（64位 Office 2016）。 - Mircea Ionica
谢谢！这对我在Office 365上起作用了。我只是从https://tablacus.github.io/scriptcontrol_en.html下载了二进制文件，如自述文件中所述。运行setup.exe并点击安装。重新启动Excel，它就可以工作了。 - Gravitate
3

遗憾的是，scriptcontrol仅为32位组件，无法在64位进程中运行。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接