Страницы: 1 2 След.
RSS
Как сделать отправку в Telegram из макроса VBA Excel, Telegram из макроса VBA Excel
 
Добрый день

Как сделать отправку в Telegram из макроса VBA Excel?
 
Хм... по идее можно через PowerShell. Напрямую из VBA наверное никак
Изменено: Илья Демид - 30.06.2017 13:46:16
 
Найти или написать API, которое будет взаимодействовать с сервером телеграмма.
 
Встречал на просторах сети решения из python и даже из 1С.
Надеюсь, из VBA Excel тоже найдется...:)
 
Telegram Bot API
Согласие есть продукт при полном непротивлении сторон.
 
В принципе, бот работает просто: посылаешь в браузере строку типа адрес + токен + id чата + команда.
  1. Создаёшь нового бота со смартфона через @FatherBot
  2. От присылает токен типа "000000000:AaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAa"
  3. Посылаешь в браузере команду вида https://api.telegram.org/bot000000000:AaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAa/getupdates и изнаёшь свой chat_id
  4. Посылаешь ...../sendmessage?chat_id=88888888&text=hello - и получаешь первое сообщение. Ура!
  5. Очень удобно! Сотрудник обновил расчеты на листе, а руководителю (мне) прилетели итоги на смартфон в telegram
В примере работающий макрос.
Но пока только текст. И только латиница.
Достаточно подставить свой токен и chat_id. И облагородить по желанию, чтобы текст сообщения брался из нужных ячеек листа, а токен и chat_id из текстовых констант.

Кто знает как составить URL в виде формате multipart/form-data для отправки фото (прикрепления файлов)?

формат команд /sendDocument, /sendPhoto, /sendAudio здесь -  Telegram Bot API
Код
Sub Send_to_Telegram_Bot_example()
Dim oHttp As Object
Dim sURI As String

'token = "00000000:AaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAa"
'chat_id = "88888888"
'txt = "hello"

'sURI = "https://api.telegram.org/bot000000000:Aa....AaAa/getme"
'sURI = "https://api.telegram.org/bot000000000:Aa....AaAa/getupdates"

'sendproto не работает!!! Блин, не знаю, как скормить строке имя файла С:\temp\pic.png?
'запрос с файлом должен быть в формате multipart/form-data
'sURI = "https://api.telegram.org/bot000000000:Aa.....AaAa/sendproto?chat_id=88888888@photo=C:\temp\pic.png"

sURI = "https://api.telegram.org/bot000000000:Aa....AaAa/sendmessage?chat_id=88888888&text=hello"

MsgBox sURI, vbInformation, "запрос"
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0
If oHttp Is Nothing Then Exit Sub
oHttp.Open "GET", sURI, False
oHttp.Send
MsgBox oHttp.ResponseText, vbInformation, "ответ"
Set oHttp = Nothing
End Sub
 
DenDen, создать скриншот нужной области на листе, сохранить в файл и передать как https://tlgrm.ru/docs/bots/api#file ?
 
В теории просто - составить URL и вбить в браузер (симулировать в VBA использование объекта браузер или MSXML.XMLHTTPRequest, как в макросе выше).
Метод Telergam API в макросе getUpdates работает нормально. Метод sendMessage тоже - текстовые сообщения на латинице отправляет.

Но метод sendPhoto не получается...
sURI = "https://api.telegram.org/bot000000000:Aa.....AaAa/sendphoto?chat_id=88888888@photo=C:\temp\pic.png"

Какая верная URL? Как правильно указать параметры и имя файла?
уже все варианты перепробовал...
C:\temp\pic.png
file:///c:\temp\pic.png

Есть пример рабочей строки? Синтаксис там сложный, где-нибудь кавычки или другой символ не поставил и ..... короче, долго ковыряться можно

Заранее благодарю, если ответ найдется  :)

PS
скриншот области на листе - отдельная задача. Excel 2010 буфер обмена в картинку не сохраняет. Есть вариант сохранять через диаграмму, но вроде криво работает.... Или есть другие решения?
 
DenDen, думаю локально не будет забирать, нужно сначала залить на сайт/фтп и потом использовать эту ссылку. Но если получится сделать локально - пиши)
 
Для отправки текста в кирилице
Код
Function RussianStringToURLEncode_New(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 Else: t = l
        End Select
        RussianStringToURLEncode_New = RussianStringToURLEncode_New & t
    Next
End Function
 
Sub TextUTF8Send()
Call Send_to_Telegram_Bot_example(RussianStringToURLEncode_New(ActiveCell.Value))
End Sub
"Правильно заданный вопрос,половина ответа!"
 
Почему, если отправлять сообщение, которое уже было отправлено, с помощью этого кода, то оно не отправляется повторно?
 
Всем привет, несмог соеденить эти два кода в один макрос, для отправки сообщений в телеграмм на русском, кто нибудь сделал?
 
Цитата
ex_kalibur написал:
UR
Перед 16 строкой (sURI = "https://api.telegram.org/bot000000000:Aa....AaAa/sendmessage?chat_id=88888888&text=hello") вставить ссылку на функцию "RussianStringToURLEncode_New"
 
Ребята, помогите объединить эти две функции в одну, неужели нет не кого кто бы мог это сделать, третий день мучаюсь, все не как не получается, и причем задача усложнилась, нужно сделать так, в табличной части екселя писать текст и нажатием кнопки с макросом отправлять в телеграм, ка кэто реализовать? есть такая штука реализованная , но она денег стоит, может кто то халяву сделает? причем большая часть уже в открытом доступе
Изменено: ex_kalibur - 20.06.2018 00:37:14
 
Вот как смог собрал из всего что писали.
romanss, , Отправляет сообщение если тест не поменялся
ex_kalibur, Отправляет по Русски
Код
Function RussianStringToURLEncode_New(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 Else: t = l
        End Select
        RussianStringToURLEncode_New = RussianStringToURLEncode_New & t
    Next
End Function
  

Sub Send_to_Telegram_Bot_example()
Dim oHttp As Object
Dim sURI As String
 
'token = "00000000:AaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAa"
'chat_id = "88888888"
'txt = "hello"
 
'sURI = "https://api.telegram.org/bot000000000:Aa....AaAa/getme"
'sURI = "https://api.telegram.org/bot000000000:Aa....AaAa/getupdates"
 
'sendproto не работает!!! Блин, не знаю, как скормить строке имя файла С:\temp\pic.png?
'запрос с файлом должен быть в формате multipart/form-data
'sURI = "https://api.telegram.org/bot000000000:Aa.....AaAa/sendproto?chat_id=88888888@photo=C:\temp\pic.png"
'Call RussianStringToURLEncode_New
tex = Cells(1, 1)
tex = RussianStringToURLEncode_New(tex)
sURI = "https://api.telegram.org/bot214343439:AAFko1ohZpgh95KTsnPskMdfsdfuVTHqFs/sendMessage?chat_id=3345500446&text=" & tex
 
'MsgBox sURI, vbInformation, "запрос"
'On Error Resume Next
'Set oHttp = CreateObject("MSXML2.XMLHTTP")
'Dim oHttp As Object
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")


'If Err.Number <> 0 Then
'Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
'End If
On Error GoTo 0
If oHttp Is Nothing Then Exit Sub
oHttp.Open "GET", sURI, False
oHttp.Send


MsgBox oHttp.ResponseText, vbInformation, "ответ"
Set oHttp = Nothing

End Sub
 
Извините, что вновь подымаю тему, а запрос через "прокси" (IP, порт) никто не знает как прописать в макросе? А то напрямую отправить не получается...
==
PS: Вот, нашел вроде, правда работает только с https proxy, SOCKS (1080 которые) выдает ошибку. Cервер нужен надежный (с высоким uptime) и ненашинский

Код
 Sub sender()

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL="...api.telegram.org..."
objHTTP.Open "POST", Url, False
objHTTP.setProxy 2, "197.159.198.190:50592"
objHTTP.setProxyCredentials "anonymous", "anonymous"
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")

End Sub
Изменено: xseed - 20.10.2018 14:16:20
 
Отправить символ перевода строки не получилось, я пробовал передавать CRLF в URL-Encoded запросе в виде %0D%0A, но символ не передается в сообщении.

Кстати, интересует обратная возможность импорта telegram сообщения бота в ячейку используя vba и telegram api
Нашел этот метод, но пока не вкурил как им пользоваться в vba:

Нашел следующий метод

https://api.telegram.org/bot{Токен}/getUpdates?offset={порядковый ID сообщения}&timeout={время ожидания перед возвратом в секундах}

https://api.telegram.org/bot"bot_key"/getUpdates?chat_id=@"channel_name"

Я так понимаю эти линки возвращают json файл, попробую импортировать его в Excel через  Power Query.  
Изменено: xseed - 22.10.2018 00:27:46
 
Отправить символ перевода строки не получилось, я пробовал передавать CRLF в URL-Encoded запросе в виде %0D%
Цитата
xseed написал:
Отправить символ перевода строки не получилось, я пробовал передавать CRLF в URL-Encoded запросе в виде %0D%0A, но символ не передается в сообщении.
Попробуйте %0A
"Правильно заданный вопрос,половина ответа!"
 
MyString = "text+1%0D%0Atext+2%0D%0A"
           Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
           Url = "https://api.telegram.org/bot_name:key/sendmessage?chat_id=38548645468&text="; & MyString

получилось
воспользовался url-encode-decode()com, видимо что-то не так закодировал
Изменено: xseed - 05.11.2018 12:44:54
 
DenDen,приветствую.
А можно ли сделать отправку сообещний от своего имени? То есть со своего профиля?
 
Все можно, у телеги открытый исходный код. Для того, чтобы отправить от конкретного пользователя, надо использовать не bot api, а telegram core api
https://core.telegram.org/api#getting-started
 
Возможно ли создать макрос, который бы делал бы рассылку эксель файлов с локального диска, через чат бота телеграм?
Видел на просторах интернета макрос, который отправляет pdf файлы, но не с локального компа, а с общедоступных ресурсов.
 
Помогите решить проблему
при запуске макроса выдает такую ошибку
 
Допишите к выделенной строке "_New"
 
Благодарю
Изменено: vikttur - 17.10.2021 15:42:02
 
ну вот опять )
а это что значит? опять ошибка (
может по этой причине макрос не отправляет текст в телеграм

ну почему у него то всё работает?
https://youtu.be/EaEaOPm8auU?t=214
Изменено: vikttur - 17.10.2021 16:16:15
 
У Вас нет функции, имя которой выделено
 
Проблема решена!  8)  
Макросы не включил, бывает  :D
Сообщения приходят мгновенно!  
 
Откопаем старую тему и подведем итоги (сам убил на это три дня и цельного ответа нигде не нашел).

Для тех, кто не знает, но очень хочет:
1. Создаем бота через Botfather, нажимает СТАРТ. В процессе создания BotFather выдаст уникальный Token.
2. В браузере выполняем https://api.telegram.org/bot[ТОКЕН_БОТА]/getUpdates, находим chat id.
3. Бот уже может принимать сообщения https://api.telegram.org/bot[ТОКЕН_БОТА]/sendMessage?chat_id=[ChatID]&text=Hello.

Если мы хотим передавать эти сообщения группе людей:
4. Создаем группу (публичную), добавляем туда бота.
5. Открываем в браузере ссылку https://api.telegram.org/bot[ТОКЕН_БОТА]/sendMessage?chat_id=@[USERNAME_ГРУППЫ]&text=тест, получаем id группы (он отрицательный).
6. Теперь можно передавать сообщения в группу: https://api.telegram.org/bot[ТОКЕН_БОТА]/sendMessage?chat_id=@[ID_КАНАЛА]&text=тест
7. Группу можно сделать приватной.

Рабочий макрос:

Код
Sub SendTelega()
    Call MessageToTelegram("Hello world!")
End Sub

' Функция для отправки кириллицы
Function RussianStringToURLEncode_New(ByVal txt As String) As String
    Dim i As Long, l As String, t 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 10: t = "%0a" 'Перевод строки
            Case Else: t = l
        End Select
        RussianStringToURLEncode_New = RussianStringToURLEncode_New & t
    Next
End Function


Sub MessageToTelegram(msg)
    Dim Token As String, ChatID As String, message As String
    Dim sURL As String, oHttp As Object, sHTML As String
    'message = RussianStringToURLEncode_New(Range("A1").Text) 'Отправляемый текст в ячейке А1
    message = RussianStringToURLEncode_New(msg)
    Token = "1774315163:AWHRA87WxIJktOt4PGGpS_HxqwqrFtmyvPG" ' токен своего бота
    ChatID = "-1034578998940" '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
 
, Добрый вечер.

Нашел на стаке испанский код https://stackoverflow.com/questions/69229718/exel-vba-send-image-using-telegram-bot-api
Работает отлично)
Код
Sub telegram_pruebas_photo()

    Const URL = "https://api.telegram.org/bot"
    Const TOKEN = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    Const METHOD_NAME = "/sendPhoto?"
    Const CHAT_ID = "-xxxxxxxxxxx"
    
    Const FOLDER = "C:\documents\SCREENSHOT\"
    Const JPG_FILE = "picture1.jpg"
    
    Dim data As Object, key
    Set data = CreateObject("Scripting.Dictionary")
    data.Add "chat_id", CHAT_ID
    
    ' generate boundary
    Dim BOUNDARY, s As String, n As Integer
    For n = 1 To 16: s = s & Chr(65 + Int(Rnd * 25)): Next
    BOUNDARY = s & CDbl(Now)

    Dim part As String, ado As Object
    For Each key In data.keys
        part = part & "--" & BOUNDARY & vbCrLf
        part = part & "Content-Disposition: form-data; name=""" & key & """" & vbCrLf & vbCrLf
        part = part & data(key) & vbCrLf
    Next
    ' filename
    part = part & "--" & BOUNDARY & vbCrLf
    part = part & "Content-Disposition: form-data; name=""photo""; filename=""" & JPG_FILE & """" & vbCrLf & vbCrLf
    
    ' read jpg file as binary
    Dim jpg
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile FOLDER & JPG_FILE
    ado.Position = 0
    jpg = ado.read
    ado.Close

    ' combine part, jpg , end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write jpg
    ado.Write ToBytes(vbCrLf & "--" & BOUNDARY & "---")
    ado.Position = 0

    Dim req As Object, reqURL As String
    Set req = CreateObject("MSXML2.XMLHTTP")
    reqURL = URL & TOKEN & METHOD_NAME
    With req
        .Open "POST", reqURL, False
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
        .send ado.read
        MsgBox .responseText
    End With

End Sub

Function ToBytes(str As String) As Variant

    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Open
    ado.Type = 2 ' text
    ado.Charset = "_autodetect"
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.read
    ado.Close

End Function
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх