ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 13663|回复: 11

[分享] createobject("scriptcontrol")遭遇ActiveX部件不能创建对象错误的解决方法

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-3-25 11:09 | 显示全部楼层 |阅读模式
在论坛里看到好多兄弟们因为office64位不兼容32位的原因,致使程序运行时出现 “
createobject("scriptcontrol")遭遇ActiveX部件不能创建对象错误”。 查找了一些资料,这个问题是可以解决的。现分享出来给大家。 不足之处望指正。

可以通过  创建一个类似ScriptControl的ActiveX objects,并通过它来调用 ““mshta x86 host”。这样就可以使原代码继续使用了。下面是具体的代码:

注意这段代码可以作为一个标准的VBA模块放在有代码中,这样遇到
createobject("scriptcontrol")时,将其改为“ CreateObjectx86("MSScriptControl.ScriptControl") ” ,程序就可继续使用原代码了。



Sub DTT_Test()

    Dim oSC As Object

    Set oSC = CreateObjectx86("MSScriptControl.ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    ' do some stuff

    CreateObjectx86 , True ' 在程序结束前关闭 mshta host

End Sub



Function CreateObjectx86(Optional sProgID, Optional bClose = False)

    Static oWnd As Object
    Dim bRunning As Boolean

    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        If bClose 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
        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:""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  



评分

6

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-8-15 15:58 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-8-24 21:59 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主,多谢分享,正好最近碰到个同类型的问题,想请教。我的是代码里有CreatObject Class类型,然后执行的时候提示429 ActiveX无法创建对象。多谢,方便的话加我微信114122888,我给你发截图发代码。

TA的精华主题

TA的得分主题

发表于 2018-10-22 11:35 | 显示全部楼层
在运行时下面代码语句处,出现运行时错误13,类型不匹配的错误:
Set CreateObjectx86 = CreateObject(sProgID)

TA的精华主题

TA的得分主题

发表于 2018-12-24 00:00 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-2-15 12:00 | 显示全部楼层
大神厉害,非常感谢,完美的解决了我的问题。
不过有个问题,CreateObjectx86函数中“#Else”后面一句建议改成:
If Not bClose Then Set CreateObjectx86 = CreateObject(sProgID)
否则在32位Excel中运行“CreateObjectx86 , True”会出错。

TA的精华主题

TA的得分主题

发表于 2019-9-10 11:38 | 显示全部楼层
感谢大神,强大的知识储备才能写得出来吧

TA的精华主题

TA的得分主题

发表于 2020-5-16 16:57 | 显示全部楼层
64位下 创建msscriptcontrol对象,确实会提示activex部件无法创建的问题,32位不会提示。好帖子要顶下咯!收藏!!!

TA的精华主题

TA的得分主题

发表于 2020-11-2 11:00 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

好高级啊!

TA的精华主题

TA的得分主题

发表于 2020-11-10 10:22 | 显示全部楼层
你好,大神,请问一下,我把你提供的代码直接复制使用,但在运行过程中一直卡在 Set CreateWindow = oShellWnd.GetProperty(sSignature) 这一段这里,请问应怎么解决?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-6-6 10:18 , Processed in 0.044295 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表