Excel VBA 使用 Telegram bot api 发送图像

问题描述 投票:0回答:2

我正在编写一个 Excel 宏,该宏在运行另一个宏后发送结果的屏幕截图 。 截取的屏幕截图以 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


这不起作用,我得到一个空的回复。

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

我已经尝试过这些页面来尝试理解:

如何使用 Excel VBA 将桌面照片发送到 telegram 用VBA将本地存储照片发送到Telegram

在电报机器人上发送本地托管的照片

将照片发送到 Telegram(API / Bot)

excel vba xmlhttprequest telegram telegram-bot
2个回答
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

-1
投票

@CDP1802 通过此VAB代码发送图片或文档时可以添加消息吗?可以升级一下吗?非常感谢你

© www.soinside.com 2019 - 2024. All rights reserved.