Excel VBA 使用 Telegram bot api 发送图像

Posted 2023-03-27

【中文标题】Excel VBA 使用 Telegram bot api 发送图像

【英文标题】：Exel VBA send image using Telegram bot api

【发布时间】：2021-11-12 16:52:50

【问题描述】：

我正在编写一个 exel 宏，它会在运行另一个宏后发送结果截图 . 截取的屏幕截图以 jpg 格式保存在目录 C:\documents\SCREENSHOT 中。 我想将 picture1.jpg "C:\documents\SCREENSHOT\picture1.jpg" 发送到使用机器人的电报组。

我可以使用以下代码轻松发送短信。

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

问题是我找不到发送存储在计算机中的图像的方法，我看到了文档，它说有必要使用 multipart/form-data 方法，但我不知道如何更改我的 Sub telegram_pruebas() 以使用该方法，我已经看到溢出堆栈中的所有示例和另一个页面，我尝试了一些这样的

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

这不起作用，我得到一个空响应。

是否有人可以修改我的代码来解决问题或至少帮助我理解我的错误..

我已经尝试过这个页面来尝试理解：

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)

还有很多其他的。

谢谢

【参考方案1】：

试试

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

【讨论】：

这很完美，非常感谢你帮了我很多。

@CDP1802 在你组合part、jpg、end的部分：当你写结束字节时，你在边界后添加了三个连字符“---”而不是2，这是有原因的吗?我注意到它也适用于 3 个连字符，但据我所知，它应该只有 2 个。

@NadAlaba 很好看，是的，只需要 2 个。