Samitha156
New Member
- Joined
- May 6, 2022
- Messages
- 5
- Office Version
- 2019
- Platform
- Windows
I have a Excel macro file that is working in 32 bit environment. But it is not working in 64 bit. My question is pretty similar to this one Excel File not working on one computer but will on another.
Here is the code and the x64Solution() function.
----------------------------------------------------------------
--------------------------------------------------------------
This is actually what happens. It run up to the very first
Then it jump right to the
Then it infinitely looping in the For loop which is
Any help will be really appreciated. Thank you
Here is the code and the x64Solution() function.
VBA Code:
Private Sub AmnestyFind()
Dim nowUTC As U, utcDate As Date, utcDiff As Double
Dim body$
Dim Strt(1 To 2)
Dim Ennd(1 To 2)
fc = UCase(mainn.[b1])
Strt(1) = mainn.[B8].Value
Ennd(1) = mainn.[C8].Value
Strt(2) = mainn.[B9].Value
Ennd(2) = mainn.[C9].Value
For z = 1 To 2
Set H = CreateObject("WinHTTP.WinHTTPRequest.5.1")
#If Win64 Then
Set x64 = x64Solution()
x64.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"
Set S = x64.CreateObjectx86("MSScriptControl.ScriptControl")
#Else
Set S = CreateObject("ScriptControl")
#End If
S.Language = "JScript"
S.AddCode "function keys(O) { var k = new Array(); for (var x in O) { k.push(x); } return k; } "
Call GetSystemTime(nowUTC)
utcDate = nowUTC.a1 & "-" & nowUTC.a2 & "-" & nowUTC.A4 & " " & nowUTC.A5 & ":" & nowUTC.A6 & ":" & nowUTC.A7
utcDiff = utcDate - Now()
body = "{""index"":""quality_intelligence_amnesty"",""search_type"":""count"",""ignore_unavailable"":true}"
body = body & Chr(10)
body = body & "{""query"":{""filtered"":{""query"":{""query_string"":{""query"":""problem_status: \""Resolved\"""",""analyze_wildcard"":true}},""filter"":{""bool"":{""must"":[{""query"":{""query_string"":{""analyze_wildcard"":true,""query"":"
body = body & """order"":{""1"":""desc""}},""aggs"":{""1"":{""sum"":{""field"":""addback_quantity""}}}}}}}}"
body = body & Chr(10)
With H
.SetAutoLogonPolicy 0
.Open "GET", "url"
.SetClientCertificate "CURRENT_USER\MY\" & Environ("USERNAME")
.Send
.Open "POST", "url=" & (Now() - 25569 + utcDiff) * 86400
.Send body
.WaitForResponse
End With
Set JSON = S.Eval("(" & H.responseText & ")")
Debug.Print H.responseText
Set JSON = CallByName(JSON, "responses", VbGet)
Set JSON = CallByName(JSON, "0", VbGet)
Set JSON = CallByName(JSON, "aggregations", VbGet)
Set JSON = CallByName(JSON, "3", VbGet)
Set JSON = CallByName(JSON, "buckets", VbGet)
Set Keys = S.Run("keys", JSON)
For Each Key In Keys
If CallByName(CallByName(JSON, Key, VbGet), "key", VbGet) = "T" Then
a = CallByName(CallByName(JSON, Key, VbGet), "doc_count", VbGet)
ElseIf CallByName(CallByName(JSON, Key, VbGet), "key", VbGet) = "F" Then
B = CallByName(CallByName(JSON, Key, VbGet), "doc_count", VbGet)
End If
Next Key
chartt.Cells(52, z + 1) = a / (a + B)
If TypeName(x64) <> "Nothing" Then x64.Close
Next z
End Sub
Private Sub FloorFind()
Dim nowUTC As U, utcDate As Date, utcDiff As Double
Dim body$
Dim Strt(1 To 2)
Dim Ennd(1 To 2)
fc = UCase(mainn.[b1])
Strt(1) = mainn.[B8].Value
Ennd(1) = mainn.[C8].Value
Strt(2) = mainn.[B9].Value
Ennd(2) = mainn.[C9].Value
For z = 1 To 2
Set H = CreateObject("WinHTTP.WinHTTPRequest.5.1")
#If Win64 Then
Set x64 = x64Solution()
x64.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"
Set S = x64.CreateObjectx86("MSScriptControl.ScriptControl")
#Else
Set S = CreateObject("ScriptControl")
#End If
S.Language = "JScript"
S.AddCode "function keys(O) { var k = new Array(); for (var x in O) { k.push(x); } return k; } "
Call GetSystemTime(nowUTC)
utcDate = nowUTC.a1 & "-" & nowUTC.a2 & "-" & nowUTC.A4 & " " & nowUTC.A5 & ":" & nowUTC.A6 & ":" & nowUTC.A7
utcDiff = utcDate - Now()
body = "{""index"":""quality_intelligence_amnesty"",""search_type"":""count"",""ignore_unavailable"":true}"
body = body & Chr(10)
body = body & "{""query"":{""filtered"":{""query"":{""query_string"":{""query"":""problem_status: \""Resolved\"""",""analyze_wildcard"":true}},""filter"":{""bool"":{""must"":[{""query"":{""query_string"":{""analyze_wildcard"":true,""query"":"
body = body & Chr(10)
With H
.SetAutoLogonPolicy 0
.Open "GET", "url"
.SetClientCertificate "CURRENT_USER\MY\" & Environ("USERNAME")
.Send
.Open "POST", "url" & (Now() - 25569 + utcDiff) * 86400
.Send body
End With
Set JSON = S.Eval("(" & H.responseText & ")")
Set JSON = CallByName(JSON, "responses", VbGet)
Set JSON = CallByName(JSON, "0", VbGet)
Set JSON = CallByName(JSON, "aggregations", VbGet)
Set JSON = CallByName(JSON, "3", VbGet)
Set JSON = CallByName(JSON, "buckets", VbGet)
Set JSON = CallByName(JSON, "0", VbGet)
Set JSON = CallByName(JSON, "4", VbGet)
Set JSON = CallByName(JSON, "buckets", VbGet)
Set JSON = CallByName(JSON, "0", VbGet)
Set JSON = CallByName(JSON, "5", VbGet)
Set JSON = CallByName(JSON, "buckets", VbGet)
Set Keys = S.Run("keys", JSON)
a = CallByName(JSON, "doc_count", VbGet)
Set JSON2 = S.Eval("(" & H.responseText & ")")
Set JSON2 = CallByName(JSON2, "responses", VbGet)
Set JSON2 = CallByName(JSON2, "0", VbGet)
Set JSON2 = CallByName(JSON2, "aggregations", VbGet)
Set JSON2 = CallByName(JSON2, "3", VbGet)
Set JSON2 = CallByName(JSON2, "buckets", VbGet)
Set JSON2 = CallByName(JSON2, "1", VbGet)
Set JSON2 = CallByName(JSON2, "4", VbGet)
Set JSON2 = CallByName(JSON2, "buckets", VbGet)
Set JSON2 = CallByName(JSON2, "0", VbGet)
Set JSON2 = CallByName(JSON2, "5", VbGet)
Set JSON2 = CallByName(JSON2, "buckets", VbGet)
Set Keys = S.Run("keys", JSON2)
B = CallByName(JSON2, "doc_count", VbGet)
chartt.Cells(53, z + 1) = a / (a + B)
If TypeName(x64) <> "Nothing" Then x64.Close
Next z
End Sub
----------------------------------------------------------------
VBA Code:
Private Function x64Solution()
Dim druifj, kindle
On Error Resume Next
druifj = 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('" & druifj & "',document.parentWindow);</script></head>""", 0, False
Do
For Each kindle In CreateObject("Shell.Application").Windows
Set x64Solution = kindle.GetProperty(druifj): If Err.Number = 0 Then Exit Function
Err.Clear
Next kindle
Loop
End Function
This is actually what happens. It run up to the very first
VBA Code:
#If Win64 Then
VBA Code:
Private Function x64Solution()
Then it infinitely looping in the For loop which is
VBA Code:
For Each kindle In CreateObject("Shell.Application").Windows
Set x64Solution = kindle.GetProperty(druifj): If Err.Number = 0 Then Exit Function
Err.Clear
Next kindle
Any help will be really appreciated. Thank you
Last edited by a moderator: