Function GetTelegramResponse(ByVal apiUrl As String) As String
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttpReq.Open "GET", apiUrl, False
    WinHttpReq.Send
    GetTelegramResponse = WinHttpReq.responseText
End Function

Sub ReadTelegramMessages()
    Dim telegramToken As String
    Dim apiUrl As String
    Dim response As String
    
    telegramToken = "YOUR_TELEGRAM_BOT_TOKEN"
    apiUrl = "https://api.telegram.org/bot" & telegramToken & "/getUpdates"
    
    response = GetTelegramResponse(apiUrl)
    
    ' Обрабатываем полученный ответ
    ' ...
End Sub

    Dim PT As PivotTable
    Set PT = ActiveSheet.PivotTables("сводная таблица1")
    PT.RefreshTable


    ' Clear any existing filters
    PT.PivotFields("дата").ClearAllFilters
    

    ' Apply the filter to show machines loaded on specific dates
    With PT.PivotFields("дата")
            For i = 1 To .PivotItems.Count
              With .PivotItems(i)
                If IsDate(.Value) Then
                  .Visible = .Value <= #3/2/2023#

                End If
              End With
            Next
                 
    End With

qt.BackgroundQuery = False 'всего то нужен был этот параметр)) 
qt.Refresh 

Sub поиск_компании_в_интернете_считать()
 
 
Dim ws As Worksheet
Dim qt As QueryTable
Dim nr As Name
Dim cn As WorkbookConnection
Наименование_компании = URL_Encode(Sheets("admin_list").Range("B2"))
ИНН = Sheets("admin_list").Range("B2")
ОКПО = Sheets("admin_list").Range("B2")
 
Set ws = ThisWorkbook.Sheets("company_search")
 
'Clear all data from the worksheet
For Each cn In ThisWorkbook.Connections
    cn.Delete
Next cn
For Each nr In ws.Names
    nr.Delete
Next nr
ws.Range("A:D").ClearContents
 
url = "http://online.igk-group.ru/ru/reports/express_reports/ext_search?name=" & Наименование_компании & "&ogrn=&inn=&okpo=&status=2&branch=2&ru="
 
'Select the worksheet where you want to import the data
Set ws = ThisWorkbook.Sheets("company_search")
 
'Create a new query table
Set qt = ws.QueryTables.Add(Connection:="URL;" & url, Destination:=ws.Range("A1"))
 
'Refresh the query table to import the data

qt.BackgroundQuery = False 'всего то нужен был этот параметр)) 


qt.Refresh 
 
Do
    'определённые действия с таблицей, которую сделает PQ, не важно какие, ибо информация сюда уже не доходит.
Loop While StrConv(Sheets("admin_list").Range("B2"), 2) <> "назад"
 
End sub

Sub поиск_компании_в_интернете_считать()


Dim ws As Worksheet
Dim qt As QueryTable
Dim nr As Name
Dim cn As WorkbookConnection
Наименование_компании = URL_Encode(Sheets("admin_list").Range("B2"))
ИНН = Sheets("admin_list").Range("B2")
ОКПО = Sheets("admin_list").Range("B2")

Set ws = ThisWorkbook.Sheets("company_search")

'Clear all data from the worksheet
For Each cn In ThisWorkbook.Connections
    cn.Delete
Next cn
For Each nr In ws.Names
    nr.Delete
Next nr
ws.Range("A:D").ClearContents

url = "http://online.igk-group.ru/ru/reports/express_reports/ext_search?name=" & Наименование_компании & "&ogrn=&inn=&okpo=&status=2&branch=2&ru="

'Select the worksheet where you want to import the data
Set ws = ThisWorkbook.Sheets("company_search")

'Create a new query table
Set qt = ws.QueryTables.Add(Connection:="URL;" & url, Destination:=ws.Range("A1"))

'Refresh the query table to import the data
qt.Refresh 

Do
    'определённые действия с таблицей, которую сделает PQ, не важно какие, ибо информация сюда уже не доходит.
Loop While StrConv(Sheets("admin_list").Range("B2"), 2) <> "назад"

End sub

Dim http As New WinHttp.WinHttpRequest

http.Open "GET", "https://api.openai.com/v1/engines/davinci/completions", False
http.setRequestHeader "Content-Type", "application/json"
http.setRequestHeader "Authorization", "Bearer YOUR_API_KEY"

http.Send

' check for a successful response
If http.Status = 200 Then
    ' process the response
    Dim responseText As String
    responseText = http.ResponseText
    ' do something with the response
    '...
End If

Sub отправкаобратногосообщения()

сообщениедляответа = "Ни видать тебе кнопок... Иди учи питон"


Dim TOKEN As String, ChatID As String, message As String
    Dim sURL As String, oHttp As Object, sHTML As String
    message = RussianStringToURLEncode_New(сообщениедляответа) 'Отправляемый текст в переменной
'RussianStringToURLEncode_New - отдельная функция для отправки русских букв. Можно без неё - сообщение отправлять на английском.

    
    TOKEN = "***********************" ' токен своего бота
    ChatID = Sheets("подсобка").Range("B12") 'id бота (для отправки только боту) или группы
    sURL = "https://api.telegram.org/bot" & TOKEN & "/sendMessage?chat_id=" & ChatID & "&text=" & message
    Set oHttp = CreateObject("Msxml2.XMLHTTP")
    oHttp.Open "POST", sURL, False
    oHttp.send
    Set oHttp = Nothing

End Sub

Sub отгрузкипарсинг()
    'Reference: Microsoft XML, v3.0
    ответ = Sheets("Лист1").Range("A1")
    Dim xml As New MSXML2.DOMDocument, elem As MSXML2.IXMLDOMElement
     
    xml.async = False 'отключаем асинхонный запрос, иначе данные не успевают загрузиться
    xml.LoadXML (ответ)  'загружаем ответ xml
    For Each elem In xml.DocumentElement.SelectNodes("//soap:Body/m:getUPDListResponse/m:return/m:НеподписанныйДокумент")
        Debug.Print elem.SelectSingleNode("m:Номер").Text
    Next elem
End Sub

For Each elem In xml.DocumentElement.SelectNodes("//soap:Envelope/soap:Body/m:getUPDListResponse/m:return/m:НеподписанныйДокумент")

Public ответ As Variant
Sub ntcn()


инн = Sheets("упд").Range("b1")
 
 'Set and instantiate our working objects
    Dim Req As Object
    Dim sEnv As String
    Dim Resp As New MSXML2.DOMDocument60
    Set Req = CreateObject("MSXML2.XMLHTTP")
    Set Resp = CreateObject("MSXML2.DOMDocument.6.0")
    Req.Open "Post", "ссылка на веб сервис 1С", False
    
 ' we create our SOAP envelope for submission to the Web Service
     sEnv = sEnv & "  <soapenv:Envelope "
     sEnv = sEnv & "  xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"""
     sEnv = sEnv & "  xmlns:itp=""rrrr"">"
     sEnv = sEnv & "  <soapenv:Header/>"
     sEnv = sEnv & "  <soapenv:Body>"
     sEnv = sEnv & "  <itp:getUPDList>"
     sEnv = sEnv & "  <itp:INN>" & инн & "</itp:INN>"
     sEnv = sEnv & "  </itp:getметод>"
     sEnv = sEnv & "  </soapenv:Body>"
     sEnv = sEnv & "  </soapenv:Envelope>"

' Send SOAP Request
    Req.send (sEnv)

ответ = Req.responseText
Call h

End Sub


Sub h()

    Dim xml As New MSXML2.DOMDocument60, elem As MSXML2.IXMLDOMElement
     
    xml.async = False 
    xml.LoadXML (ответ)  
    For Each elem In xml.DocumentElement.SelectNodes("//soap:Body/m:getUPDListResponse/m:return/m:НеподписанныйДокумент")
        Debug.Print elem.SelectSingleNode("m:Номер").Text
    Next elem
End Sub

Sub h()

    Dim xml As New MSXML2.DOMDocument60, elem As MSXML2.IXMLDOMElement
     
    xml.async = False 'отключаем асинхонный запрос, иначе данные не успевают загрузиться
    xml.LoadXML (ответ)  'загружаем ответ xml
    For Each elem In xml.DocumentElement.SelectNodes("//soap:Body/m:getUPDListResponse/m:return/m:НеподписанныйДокумент")
        Debug.Print elem.SelectSingleNode("m:Номер").Text
    Next elem
End Sub

лево = InStr(Ответ, "<m:НеподписанныйДокумент>") + 25
право = InStr(лево, Ответ, "</m:НеподписанныйДокумент>")
середина = право - лево
ОКВЭД = Mid(Ответ, лево, середина)

<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope">
   <soap:Body>
      <m:getUPDListResponse xmlns:m="itPersona">
         <m:return xmlns:xs="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
            <m:НеподписанныйДокумент>
               <m:Номер>1234 </m:Номер>
               <m:Дата>2020-09-05</m:Дата>
               <m:Сумма>50.7</m:Сумма>
               <m:УИД>1234</m:УИД>
               <m:ИдентификторЭДО>1234</m:ИдентификторЭДО>
               <m:ОбменЭДО>false</m:ОбменЭДО>
               <m:Статус>Отправлен по почте</m:Статус>
               <m:ДатаСтатуса>2020-09-30T10:48:14</m:ДатаСтатуса>
           </m:НеподписанныйДокумент>
         </m:return>
      </m:getUPDListResponse>
   </soap:Body>
</soap:Envelope>

link = "https://bo.nalog.ru/search?query=" & ИНН & "&page=1"
CreateObject("WScript.Shell").Run link
Application.Wait Time:=Now + TimeSerial(0, 0, 2)
Application.SendKeys "^s"
Application.Wait Time:=Now + TimeSerial(0, 0, 2)
Application.SendKeys "~"

curl -o C:\temp\myfile.pdf  https://bo.nalog.ru/download/bfo/pdf/11175198?period=2021 --ssl-no-revoke