我正在编写一个 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
这不起作用,我得到一个空的回复。
有人可以修改我的代码来解决问题,或者至少帮助我理解我的错误..
我已经尝试过这些页面来尝试理解:
尝试
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 通过此VAB代码发送图片或文档时可以添加消息吗?可以升级一下吗?非常感谢你