Search code examples
excelvbaxmlhttprequesttelegramtelegram-bot

Excel VBA send image using Telegram bot api


I am programing an excel macro that sends a screenshots of the results after running another macro . The taken screenshot is saved as a jpg image in the directory C:\documents\SCREENSHOT. I want to send the picture1.jpg "C:\documents\SCREENSHOT\picture1.jpg" to a telegram group usig a bot.

I can easily send text messages using the following code.

Private Sub telegram_pruebas() 'Solicita un mensaje esta función del mensaje y el ID del chat

    Dim objRequest As Object 'Con lo que se crea la solicitud de internet
    Dim datos_posteo As String 'Lo que enviará por mensaje
    
    Dim token, ChatID, mensaje As String

    token = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    ChatID = -xxxxxxxxxxxx
    mensaje = "xxxxxxxx"
    
    datos_posteo = "chat_id=" & ChatID & "&text=" & mensaje 'Se 'Se le muestra al robot que enviar y a que chat
    
    
    Set objRequest = CreateObject("MSXML2.XMLHTTP") 'Crea un request como archivo XHLM
    
    With objRequest
        .Open "POST", "https://api.telegram.org/bot" & token & "/sendMessage?", False 'Aqui esta la dirección del sitio web con el api del robot
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" 'No se que sea
        .send (datos_posteo) 'La indicación de enviar el texto al chat
    End With
    
End Sub

The problem is that I can not find the way to send a image that is stored in my computer, I saw the documentation and it says that it is necessary to use the multipart/form-data method but I do not know how to change my Sub telegram_pruebas() to use that method, I have seen all the examples in stack of overflow and another pages and I tried some like this

Private Sub telegram_pruebas_photo() 'Solicita un mensaje esta función del mensaje y el ID del chat

    Dim objRequest As Object 'Con lo que se crea la solicitud de internet
    Dim datos_posteo As String 'Lo que enviará por mensaje
    
    Dim token, ChatID, photo As String
    
    token = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
    ChatID = -xxxxxxxxxxx
    photo = "C:\documents\SCREENSHOT\picture1.jpg"
    
    datos_posteo = "chat_id=" & ChatID & "&photo=" & photo 'Se 'Se le muestra al robot que enviar y a que chat
    
    
    Set objRequest = CreateObject("MSXML2.XMLHTTP") 'Crea un request como archivo XHLM
    
    With objRequest
        .Open "POST", "https://api.telegram.org/bot" & token & "/sendPhoto?", False 'Aqui esta la dirección del sitio web con el api del robot
        .setRequestHeader "Content-Type", "multipart/form-data" 'No se que sea
        .send (datos_posteo) 'La indicación de enviar el texto al chat
        response = .responseText
    End With
    MsgBox response
End Sub


this does not works, i get a empty response.

Does somebody can modify my code to get the problem or at least help me to understand my error..

I have tried this pages to try to undertand:

How to send a desktop photo to telegram using Excel VBA Sending local storage photo into Telegram with VBA

Sending locally hosted photo on telegram bot

Sending Photo to Telegram (API / Bot)


Solution

  • Try

    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