Fatal编程技术网
  • vba/
  • Vba 让ScriptControl与Excel 2010 x64一起使用

Vba 让ScriptControl与Excel 2010 x64一起使用

vba excel com

Vba 让ScriptControl与Excel 2010 x64一起使用,vba,excel,com,excel-2010,scriptcontrol,Vba,Excel,Com,Excel 2010,Scriptcontrol,我试图使用给定的解决方案，但是，每当我尝试运行最基本的任何东西时，都会出现对象未定义的错误。我认为这是我的错（没有安装ScriptControl）。但是，我尝试按照中所述进行安装，但没有成功 我使用Office 2010 64位运行Windows 7 Professional x64。遗憾的是，scriptcontrol只是一个32位组件，不会在64位进程中运行。您可以创建ActiveX对象，如scriptcontrol，在64位VBA版本上通过mshta x86主机在32位Office版本上可

我试图使用给定的解决方案，但是，每当我尝试运行最基本的任何东西时，都会出现
对象未定义的错误。我认为这是我的错（没有安装ScriptControl）。但是，我尝试按照中所述进行安装，但没有成功


我使用Office 2010 64位运行Windows 7 Professional x64。
遗憾的是，scriptcontrol只是一个32位组件，不会在64位进程中运行。
您可以创建ActiveX对象，如
scriptcontrol
，在64位VBA版本上通过mshta x86主机在32位Office版本上可用，下面是一个示例（将代码放入标准VBA项目模块中）：

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


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



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


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

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

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


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



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



选项显式
子测试（）
作为对象的Dim oSC
设置oSC=CreateObjectx86（“ScriptControl”）“通过x86 mshta主机创建ActiveX
调试.打印TypeName（oSC）的脚本控件
“做点什么
'mshta窗口正在运行，直到对窗口的静态oWnd引用丢失
'如有必要，您可以通过CreateObjectx86 Empty手动关闭mshta主机窗口
端接头
函数CreateObjectx86（可选的sProgID）
静态所有者作为对象
Dim bRunning作为布尔函数
#如果是Win64，那么
bRunning=InStr（TypeName（oWnd），“HTMLWindow”）>0
选择Case True
案例IsMissing（sProgID）
如果是bRunning，则oWnd.Lost=False
退出功能
案例IsEmpty（sProgID）
如果是布鲁宁，那么是自己。关闭
退出功能
案例不是布鲁宁
设置oWnd=CreateWindow（）
oWnd.execScript“函数CreateObjectx86（sProgID）：设置CreateObjectx86=CreateObject（sProgID）结束函数”，“VBScript”
oWnd.execScript“var Lost，App；”：设置oWnd.App=Application
oWnd.execScript“Sub Check（）：在出现错误时继续下一步：Lost=True:App.Run（““CreateObjectx86”）：如果丢失并且（Err.Number=1004或Err.Number=0），则关闭：End If End Sub”，“VBScript”
oWnd.execScript“setInterval（'Check（）；'，500）；”
结束选择
设置CreateObjectx86=oWnd.CreateObjectx86（sProgID）
#否则
设置CreateObjectx86=CreateObject（sProgID）
#如果结束
端函数
函数CreateWindow（）
"来源:http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
模糊签名，oShellWnd，oProc
出错时继续下一步
直到Len（sSignature）=32
sSignature=sSignature&Hex（整数（Rnd*16））
环
CreateObject（“WScript.Shell”）。运行“%systemroot%\syswow64\mshta.exe关于：”“moveTo（-32000，-32000）；document.title='x86Host'Shell.putproperty（“&sSignature&”，document.parentWindow）；“”，0，False
做
对于CreateObject（“Shell.Application”）.Windows中的每个oShellWnd
Set CreateWindow=oShellWnd.GetProperty（sSignature）
如果Err.Number=0，则退出函数
呃，明白了
下一个
环
端函数


更新2


由于注意到权限问题，已拒绝使用
Scriptlet.TypeLib
。
对于32位版本的控件，可以使用64位替换。Google For Tabalacus脚本控件。如果需要，可以使用免费VS版本编译控件。
要想有用，我们需要查看您尝试的确切代码，并获得错误（以及从您的代码的哪一行）Tim-我也遇到了同样的问题。我使用的代码与Codo对链接问题的公认答案中的代码完全相同（从这个问题的顶行链接）。运行TestJSONAccess Sub时，我收到一个错误，说“运行时错误‘429’：ActiveX组件无法创建对象”从InitScriptEngine子项的第一行开始（设置ScriptEnging=New ScriptControl）。我已经设置了对msscript.ocx文件的引用。惊人的解决方案，它应该是公认的答案，您认为有没有办法在宏结束时自动关闭窗口？@GBACCETA我发布了窗口自动关闭的解决方案。@omegastripes谢谢，我一回到该项目的工作中就会尝试，但是从这应该是公认的答案，就像charm@SlowLearner问题是由不正确的属性名称引起的。
oWnd.App
可以，
oWnd.App
不起作用。这就像一个符咒，应该是公认的答案！：）是的，我知道这很容易：）TABLACUSCRIPTCONTROL在比2013年更新的64位Office中不起作用。它甚至没有出现在工具->参考对话框中。这是在2018年7月向他们报告的，他们的回答非常令人沮丧和悲伤：对我也起作用（64位Office 2016）