获取ScriptControl使用Excel 2010 x64

我试图使用this给出的解决方案，但是，每当我尝试运行最基本的任何事情时，都会收到Object not Defined错误。我认为这将是我的错（没有安装ScriptControl）。但是，我试图按照here中的描述安装，无济于事。获取ScriptControl使用Excel 2010 x64

我使用Office 2010 64位版本运行Windows 7 Professional x64。

来源

2012-03-15 Proto

为了有用，我们就需要看你尝试过确切的代码，并得到了错误（和从中行代码的） – 2012-03-15 18:53:55

蒂姆 - 我有同样的问题。我使用Codo接受答案的确切代码来链接问题（从这个问题的最上面一行连接）。当运行TestJSONAccess Sub时，我从InitScriptEngine子句的第一行（Set ScriptEnging = New ScriptControl）收到一个错误，提示“运行时错误'429'：ActiveX组件无法创建对象”。我已经将引用设置为msscript.ocx文件。 – 2012-03-21 17:10:40

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

来源

2013-06-28 21:12:00

-1

在VBA编辑器上，转至工具>参考并启用Microsoft脚本控制。

来源

2013-04-30 18:13:04 Mauricio

您可以创建ActiveX对象，如ScriptControl，它在通过对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 
    sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38) 
    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键+标签隐藏 HTA窗口：

此外，您必须在代码末尾关闭HTA窗口CreateObjectx86 Empty。

UPDATE

您可以将自动关闭主窗口：通过创建类的实例或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 
     sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38) 
     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毫秒检查VBA的Static oWnd变量Static oWnd变量的调用CreateObjectx86的状态，通过内部setInterval()函数没有参数，如果参考丢失（用户在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 
    sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38) 
    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

来源

2016-06-30 22:49:50 omegastripes

哇，很酷。 – 2016-07-23 21:54:21

惊人的解决方案，它应该是被接受的答案，你认为有一种方法可以在宏的末尾自动关闭窗口？ – gbaccetta 2016-08-25 12:06:00

@gbaccetta我发布了窗户自锁的解决方案。 – omegastripes 2016-10-03 21:22:03

获取ScriptControl使用Excel 2010 x64

回答

相关问题