在论坛里看到好多兄弟们因为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()
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
|