获取ScriptControl以使用Excel 2010 x64
我试图使用解决这个问题 ，但是，每当我尝试运行最基本的东西，我得到一个Object not Defined错误。 我以为这是我的错（没有安装ScriptControl）。 不过，我试着按照这里所描述的安装，无济于事。
我正在使用Office 2010 64位版本运行Windows 7 Professional x64。
不幸的是，scriptcontrol只是一个32位组件，不会在64位进程中运行。
您可以通过64位VBA版本上的mshta x86主机创build32位Office版本上提供的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 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进程运行是必要的，这是在任务pipe理器中列出，并按Alt + Tab隐藏的HTA窗口显示：
你也必须通过CreateObjectx86 Empty来closures你的代码末尾的HTA窗口。
UPDATE
您可以使主窗口自动closures：创build类实例或mshta主动跟踪。
第一种方法假定你创build一个类实例作为一个包装器，它使用Private Sub Class_Terminate()closures窗口。
注意：如果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 oWndvariables调用CreateObjectx86状态通过内部setInterval()函数没有参数，并退出，如果参考丢失（用户已按VBA项目窗口中的重置，或工作簿已closures（错误1004））。
注意：由用户编辑的工作表单元格的VBA断点（错误57097）打开对话框模式窗口（如打开/保存/选项（错误-2147418111））将暂停跟踪，因为它们使来自mshta的外部调用的应用程序无响应。 这样的行为exception处理完成后，代码将继续工作，没有崩溃。
将下面的代码放在一个标准模块中：
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
在VBA编辑器上，转至工具>参考并启用Microsoft脚本控制。
