###DECLARE###
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
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
###DECLARE###
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Url = "https://api.n-tech.by/authorization/login"
objHTTP.Open "POST", Url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/105.0.0.0 Safari/537.36"
objHTTP.setRequestHeader "Host", "api.n-tech.by"
objHTTP.setRequestHeader "X-Requested-With", "XMLHttpRequest"
objHTTP.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
objHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
'objHTTP.setProxy 2, "http://127.0.0.1:8888", ""
objHTTP.SetOption(2) = 13056
'##### поменяйте логин и пароль #####
objHTTP.send "{""username"":""Логин"",""password"":""Пароль""}"
replyTXT = objHTTP.responseText
If objHTTP.Status = "200" Then 'success
Set scriptControl = CreateObjectx86("ScriptControl")
scriptControl.Language = "JScript"
Set objJS = scriptControl.Eval("(" + replyTXT + ")")
authTok = "Bearer " & CallByName(objJS, "token", VbGet)
Url = "https://api.n-tech.by/price/download_buh"
Set objHTTP = Nothing
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "POST", Url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/105.0.0.0 Safari/537.36"
objHTTP.setRequestHeader "Host", "api.n-tech.by"
objHTTP.setRequestHeader "X-Requested-With", "XMLHttpRequest"
objHTTP.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
objHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
'objHTTP.setProxy 2, "http://127.0.0.1:8888", ""
objHTTP.SetOption(2) = 13056
objHTTP.setRequestHeader "authorization", authTok
objHTTP.send "{""recommendedOnly"":false,""rezerv"":true,""formula"":""x""}"
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1
objStream.Write objHTTP.responseBody
'##### поменяйте путь к файлу #####
objStream.SaveToFile "Путь к файлу с расширением XLS", 2
objStream.Close
CreateObjectx86 Empty
Else
'Do something
End If
| 
