0

Using VBA (Visual Basic for Applications), I am attempting to send a local document via the Telegram Bot API. I have been able to send a Photo successfully and attempted to modify the code in order to send a document. I am attempting to use the multipart/form-data method of loading the file.

When running the code, I get the following response from the Telegram server: {"ok":false,"error_code":400,"description":"Bad Request: there is no document in the request"}

Here is a solution for sending a photograph and I have used this successfully: Exel VBA send image using Telegram bot api

However, I now want to send a PDF document rather than an image and this is where I am stuck. Below is the code adapted from the sending of an image in an attempt to send a PDF document.

@CDP1802 - perhaps you are able to assist?

Sub Telegram_PDF()

Const URL = "https://api.telegram.org/bot"
Const TOKEN = "**Token**"
Const METHOD_NAME = "/sendDocument?"
Const CHAT_ID = "**Chat ID**"

Const FOLDER = "C:\Users\rk\Downloads\"
Const JPG_FILE = "babok-30-poster.pdf"

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=""Document""; 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.ServerXMLHTTP.6.0")
reqURL = URL & TOKEN & METHOD_NAME
With req
    .Open "POST", reqURL, False
    .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
    .send ado.read
    Debug.Print .responseText
    End With
End Sub
IsNull
  • 11
  • 1
  • Please specify "I am stuck" - otherwise it is very hard to help you (see [ask] and [It's not working](http://idownvotedbecau.se/itsnotworking/)) – Ike Oct 04 '21 at 08:01

1 Answers1

0

Try this.

P.S: Thanks to @CDP1802

Code:

Sub send_Document()

    Const URL = "https://api.telegram.org/bot"
    Const TOKEN = "*TOKEN*"
    Const METHOD_NAME = "/sendDocument?"
    Const CHAT_ID = "*CHAT_ID*"
    
    Const FOLDER = "*PATH_TO_FILE*"
    Const DOCUMENT_FILE = "*FILENAME*"
    
    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=""document""; filename=""" & DOCUMENT_FILE & """" & vbCrLf & vbCrLf
    
    ' read document file as binary
    Dim doc
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile FOLDER & DOCUMENT_FILE
    ado.Position = 0
    doc = ado.read
    ado.Close

    ' combine part, document, end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write doc
    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

Change the key variables!

Harry
  • 1
  • 1