1. 首頁
  2. 問答
  3. 獲取ScriptControl使用Excel 2010 x64

獲取ScriptControl使用Excel 2010 x64

2012-03-15 18 views
4

我試圖使用this給出的解決方案，但是，每當我嘗試運行最基本的任何事情時，都會收到Object not Defined錯誤。我認爲這將是我的錯（沒有安裝ScriptControl）。但是，我試圖按照here中的描述安裝，無濟於事。獲取ScriptControl使用Excel 2010 x64

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

來源

2012-03-15 Proto

+0

爲了有用，我們就需要看你嘗試過確切的代碼，並得到了錯誤（和從中行代碼的） – 2012-03-15 18:53:55

+0

蒂姆 - 我有同樣的問題。我使用Codo接受答案的確切代碼來鏈接問題（從這個問題的最上面一行連接）。當運行TestJSONAccess Sub時，我從InitScriptEngine子句的第一行（Set ScriptEnging = New ScriptControl）收到一個錯誤，提示「運行時錯誤'429'：ActiveX組件無法創建對象」。我已經將引用設置爲msscript.ocx文件。 – 2012-03-21 17:10:40

回答

2

不幸的是，scriptcontrol只是一個32位組件，不會在64位進程中運行。

來源

2013-06-28 21:12:00

-1

在VBA編輯器上，轉至工具>參考並啓用Microsoft腳本控制。

來源

2013-04-30 18:13:04 Mauricio

10

您可以創建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窗口：

enter image description here

此外，您必須在代碼末尾關閉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

+0

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

+0

驚人的解決方案，它應該是被接受的答案，你認爲有一種方法可以在宏的末尾自動關閉窗口？ – gbaccetta 2016-08-25 12:06:00

+1

@gbaccetta我發佈了窗戶自鎖的解決方案。 – omegastripes 2016-10-03 21:22:03

相關問題

 相關問題