B2B поставщиков через макросы

1. Создайте группу в Quad.Magic в которой будут задания для получения прайсов из B2B, если такой группы у вас еще нет

2. Добавьте действие с типом “Выполнить макрос Excel”.

В Настройка 1 и Настройка 2 действия укажите путь к пустому файлу Excel (просто сохраните пустой файл из Excel на диск и используйте этот 1 файл во всех действиях)

3. В Настройка 3 добавьте макрос для получения прайса поставщика, внесите в него необходимые изменения.

4. Группу действий по скачиванию прайсов из B2B можно выполнять по расписанию с помощью SyncX или же добавить ее выполнения в начало групп действий обновления цен и полного обновления.

Вы можете заказать разработку макроса у любого программиста VBA и использовать его в программе

Готовые макросы

Беларусь

n-tech.by

В макросе нужно ввести ваш логин и пароль

И указать путь к файлу, в который будет сохранено. Файл с расширением XLS, например

f:\Quad Solutions\files\2_ price\n-texh.xls

Текст макроса:

###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