Function httpSend(url As String) As String
    Set httpRequest = CreateObject("MSXML2.XMLHTTP") 'Msxml2.XMLHTTP.6.0
    Debug.Print ("GET send: " & url)
    httpRequest.Open "GET", url, False
    httpRequest.Send
    httpSend = httpRequest.responseText
End Function

Public Function RStURL(ByVal txt As String) As String
    For i = 1 To Len(txt)
        l = Mid(txt, i, 1)
        Select Case AscW(l)
            Case Is > 4095: T = "%" & Hex(AscW(l) \ 64 \ 64 + 224) & "%" & Hex(AscW(l) \ 64) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
            Case Is > 127: T = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
            Case 32: T = "%20"
            Case 43: T = "%2b"
            Case 47: T = "%2F"
            Case Else: T = l
        End Select
        RStURL = RStURL & T
    Next
End Function

Public Function EncodeFile(strPicPath As String) As String
    Const adTypeBinary = 1          ' Binary file is encoded

    ' Variables for encoding
    Dim objXML
    Dim objDocElem

    ' Variable for reading binary picture
    Dim objStream

    ' Open data stream from picture
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile (strPicPath)

    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    objDocElem.DataType = "bin.base64"

    ' Set binary value
    objDocElem.nodeTypedValue = objStream.Read()

    ' Get base64 value
    EncodeFile = objDocElem.Text

    ' Clean all
    Set objXML = Nothing
    Set objDocElem = Nothing
    Set objStream = Nothing

End Function

{
    "fields": {
        "ufCrm1617027453943": [
             "myfile.pdf", 
             "...base64_encoded_file_content..."
        ]
    }
}

let
    Url = "https://сайт.ru/rest/доступ/ключ/tasks.task.list.json?filter[STATUS]=-1&start=",
    RecordsPerPage = 50,
    Source = Json.Document(Web.Contents(Url & "1")),
    TotalCount = Source[total],
    PagesCount = Number.RoundUp(TotalCount / RecordsPerPage),
    GetRecords = (start) =>
let
            PageJson = Json.Document(Web.Contents(Url & Text.From(start))),
            PageList = PageJson[result][tasks],
            ToTable = Table.FromRecords(PageList),
            DownloadedTable = Table.ExpandRecordColumn(ToTable, "responsible", {"name"}, {"name"}),
            ExpandedTable = Table.SelectColumns(DownloadedTable,{"id", "name"})
        in
            ExpandedTable,
    Pages = List.Skip(List.Generate(() => 1, each _ <= PagesCount, each _ + 1), 1),
    Records = List.Generate(() => GetRecords(1), each List.Count(_) > 0, each GetRecords(List.Last(List.LastN(Pages, 1)) * RecordsPerPage + 1)),
    Result = Table.Combine(Records)
in
    Result

Public Sub RunPromo(itm As Outlook.MailItem)
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("C:\Autoreport\OLAPGO.xlsm")
xlApp.Application.Visible = True
xlApp.Run "OLAPGO.xlsm!StartSubs"
xlWb.Close True: xlApp.Quit
End Sub

Sub StartSubs()

Set xlWb = Workbooks.Open("C:\Autoreport\PAFIN.xlsm")
Application.Run "PAFIN.xlsm!GoSend", 1, 1, "XXX" ' ХХХ - реальный ID чата

End Sub

Sub GoSend(Go As Integer, ExitEx As Integer, ChatIDD As String)
Dim ExName As String, rDataR As Range, Pic As String, CFO As String, CFO1 As String
Application.Calculation = xlManual
Application.DisplayAlerts = False

If Go = 1 Then

ExName = ThisWorkbook.Name
ThisWorkbook.RefreshAll

Calculate
Set rDataR = SelectAll(ExName, "Main", 21, 1, 34, 16)
Pic = RtP(rDataR, "PA")
Call SendBitrix(ChatIDD, Pic)

For i = 1 To 10
CFO = ActiveWorkbook.Sheets("Список").Cells(i, 1)
CFO1 = CFO
CFO = Replace("[ЦФО].[ЦФОАналитика].&[CFO]", "CFO", CFO)
ActiveWorkbook.SlicerCaches("Срез_ЦФО_Аналитика").VisibleSlicerItemsList = Array(CFO)
Calculate
Set rDataR = SelectAll(ExName, "ЦФОData", 1, 1, 42, 16)
Pic = RtP(rDataR, CFO1)
Call SendBitrix(ChatIDD, Pic)
Next i

End If

If Weekday(Now) = 2 Then
CopyBook = ThisWorkbook.Name
With Workbooks(CopyBook).Sheets("Main")
TextCopy = .Range(.Cells(7, 2), .Cells(16, 2))
.Cells(7, 16).Resize(UBound(TextCopy, 1), UBound(TextCopy, 2)).Value = TextCopy
End With
End If

Function RtP(Sel As Range, Optional Chen As String)
    Dim sName As String, wsTmpSh As Worksheet, i As Long, Name As String, Folder As String
    
    FullPath = ActiveWorkbook.FullName
    i = InStrRev(FullPath, "\") 
    Name = Mid(FullPath, i + 1)
    Folder = Left(FullPath, i)
    
    If TypeName(Sel) <> "Range" Then
        Exit Function
    End If

    With Sel
        'Application.CutCopyMode = False
        '.Copy
        .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        Set wsTmpSh = ThisWorkbook.Sheets.Add
        If Chen <> "" Then sName = Folder & Chen & ".png" Else sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_Range" & ".png"
        With wsTmpSh.ChartObjects.Add(0, 0, .Width, .Height).Chart
            .ChartArea.Border.LineStyle = 0
            .Parent.Select
            .Paste
            .Export Filename:=sName, FilterName:="png"
            .Parent.Delete
        End With
    End With
    wsTmpSh.Delete
    RtP = sName
End Function

Function SelectAll(table As String, shet As String, startrow As Long, startcol As Long, Optional FinRow As Long, Optional FinCol As Long)
With Workbooks(table).Sheets(shet)
If FinRow = 0 Then lLastRow = .Cells(Rows.Count, 2).End(xlUp).Row Else lLastRow = FinRow
If FinCol = 0 Then lLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column Else lLastCol = FinCol
Set SelectAll = .Range(Sheets(shet).Cells(startrow, startcol), Sheets(shet).Cells(lLastRow, lLastCol))
End With
End Function

Function SendBitrix(DialogID As String, Filename As String)
PuthExe = "\\SRVDC\Autoreport\bitrix.exe"
HookId = "XXX" ' ХХХ - условно корректное значение
HookKey = "XXX" ' ХХХ - условно корректное значение
Folder = "XXX"  ' ХХХ - условно корректное значение
WHat = Len(DialogID)
If Len(DialogID) > 4 Then
ShellParam = PuthExe & " -id " & HookId & " -profile " & HookKey & " -storage " & Folder & " -input-file " & Filename & " -chat " & DialogID
Else
ShellParam = PuthExe & " -id " & HookId & " -profile " & HookKey & " -storage " & Folder & " -input-file " & Filename & " -dialog " & DialogID
End If
Set WshShell = CreateObject("WScript.Shell")
Return1 = WshShell.Run(ShellParam, 0, True)
Kill (Filename)
End Function

' This book a have list?
Function SheetExists(SheetName As String) As Boolean
On Error Resume Next
SheetExists = Not Sheets(SheetName) Is Nothing
End Function

' Chek on Name List
Function CheckListSub(SheetName As String) As String
Dim wb As Workbook
Set wb = SheetName

CountList = 0

If SheetExists("Data") Then
    Set CheckList = wb.Worksheets("Data")
    CountList = CountList + 1
End If

If SheetExists("Динамика KPIs") Then
    Set CheckList = wb.Worksheets("Динамика KPIs")
    CountList = CountList + 1
End If

If CountList = 0 Then
MsgBox "Оба листа отсутствуют"
CheckList = "Error"
End If
If CountList = 2 Then
MsgBox "Оба листа присутствуют"
CheckList = "Error"
End If

End Function

Sub GoData()
     Application.Calculation = xlCalculationManual
     avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Âûáåðèòå îò÷åò ", , False)

    If VarType(avFiles) = vbBoolean Then
        'áûëà íàæàòà êíîïêà îòìåíû - âûõîä èç ïðîöåäóðû
        MsgBox "Íå âûáðàí èñòî÷íèê äàííûõ"
        Exit Sub
    End If
    
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

i = InStrRev(avFiles, "\") 
NameFile = """ & Mid(avFiles, i + 1) & """

Workbooks.Open Filename:=avFiles

Set Database = ActiveWorkbook
CheckList = CheckListSub(NameFile)

ActiveWindow.Close False

        Calculate
        Application.Calculation = xlAutomatic
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

End Sub