[vba] CreateObject 오류시 x64에서 ScriptControl등 사용하는 방법
vba 사용하는 사람이면 그냥 32비트 깔아라...
엑셀 2016을 설치하고 나서 영 불편한 게 아니네요....
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
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
마이크로소프트는
"대부분의 사용자에게 32 비트 오피스가 권장된다"
라고 말했다.
https://technet.microsoft.com/en-us/library/ee681792.aspx
에서 발췌한 내용입니다.
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() 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 |