使用VBA通过Telegram Bot API发送本地PDF返回400错误如何解决

问题根因 #

你的代码报错是因为表单字段名不符合Telegram Bot API的规范：sendDocument接口要求上传文件对应的表单字段名必须为全小写的document，你代码中写的是name="Document"，首字母大写导致服务器无法识别到请求中的文件，因此抛出了「there is no document in the request」的错误。

其他可优化点（可选，不影响核心功能） #

1. 存储文件名的常量JPG_FILE语义和实际存储的PDF不符，建议修改为PDF_FILE提升代码可读性
2. multipart/form-data的标准结束标识是--[边界值]--，你当前代码写的是--" & BOUNDARY & "---多了一个横杠，部分场景下可能引发解析异常，建议调整
3. POST请求的接口地址不需要末尾的?，可以移除METHOD_NAME常量末尾的问号

修复后完整代码 #

Sub Telegram_PDF()

    Const URL = "https://api.telegram.org/bot"
    Const TOKEN = "**替换为你的Bot Token**"
    Const METHOD_NAME = "/sendDocument" ' 移除多余的问号
    Const CHAT_ID = "**替换为你的Chat ID**"

    Const FOLDER = "C:\Users\rk\Downloads\"
    Const PDF_FILE = "babok-30-poster.pdf" ' 调整常量名更贴合实际内容

    Dim data As Object, key
    Set data = CreateObject("Scripting.Dictionary")
    data.Add "chat_id", CHAT_ID

    ' 生成随机边界值
    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
    ' 修正字段名为全小写document
    part = part & "--" & BOUNDARY & vbCrLf
    part = part & "Content-Disposition: form-data; name=""document""; filename=""" & PDF_FILE & """" & vbCrLf & vbCrLf

    ' 读取PDF文件为二进制
    Dim pdfBinary
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 '二进制模式
    ado.Open
    ado.LoadFromFile FOLDER & PDF_FILE
    ado.Position = 0
    pdfBinary = ado.Read
    ado.Close

    ' 拼接完整请求体
    ado.Open
    ado.Position = 0
    ado.Type = 1 '二进制模式
    ado.Write ToBytes(part)
    ado.Write pdfBinary
    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

' 如果运行提示ToBytes函数未定义，补充以下代码即可
Function ToBytes(str As String) As Variant
    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Charset = "utf-8"
    ado.Open
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.Read
    ado.Close
    Set ado = Nothing
End Function

内容的提问来源于stack exchange，提问作者IsNull