Telegram API Question posted in
A comprehensive official documentation can be found here.

Sending local photos via VBA to Telegram – Telegram API

I’m trying to send a local photo using VBA or VBScript. The solutions I found are either for sending URLs instead of files, or for other than VBA or VBScript.

Sub TelegramAuto()
    
    Dim ws As Worksheet
    Set ws = Sheets("hidden")
    Set ws1 = Sheets("Dashboard")
    
    Dim objRequest As Object
    Dim strChatId As String
    Dim strMessage As String
    Dim strPhoto As String
    Dim strPostPhoto As String
    Dim strPostData As String
    Dim strResponse As String
    
     strChatId = <id>
     strMessage = ws.Range("J5") & Format(ws1.Range("D2"), "mm/dd/yyyy") & " " & ws1.Range("D4") & " " & ws1.Range("D6") _
                    & " " & ws1.Range("K6")
     strPhoto = "C:/Users/mhjong/Desktop/GP_FS_Breakdown.png"
     
    strPostData = "chat_id=" & strChatId & "&text=" & strMessage
    strPostPhoto = "chat_id=" & strChatId & "&photo=" & strPhoto
     
     Set objRequest = CreateObject("MSXML2.XMLHTTP")
    With objRequest
      .Open "POST", "https://api.telegram.org/bot<token>/sendMessage?", False
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      .send (strPostData)
    End With

    With objRequest
      .Open "POST", "https://api.telegram.org/bot<token>/sendPhoto?", False
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      .Send (strPostPhoto)
    End With
    
    End Sub

I can send messages. I cannot find the syntax to upload a local image and send it to Telegram.

Tags:

2

Answers


  1. 0 
    strPhoto = "image link"
strPostPhoto = "chat_id=" & strChatId & "&photo=" & strPhoto
With objRequest
  .Open "POST", "https://api.telegram.org/bot<Token>/sendPhoto?" & strPostPhoto, False
  .send
End With
    Login or Signup to reply.
  2. 0 
    Public Function tmBotSend(Token As String, chat_id As String, Optional text As String = "", Optional filename As String = "", Optional pavd As String = "") As String
 'https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=93149&TITLE_SEO=93149-kak-sdelat-otpravku-v-telegram-iz-makrosa-vba-excel&MID=1193376#message1193376
 'pavd as photo animation audio voice video document
 '4096 chars for message.text, 200 chars for message.caption
 Const adTypeBinary = 1
 Const adTypeText = 2
 Const adModeReadWrite = 3
 Const telegram = "https://api.telegram.org/bot"
 Dim part As String
 part = bond("--") & form("chat_id") & chat_id & bond()
 Dim dfn As String
 If Len(filename) Then dfn = Dir(filename)
 Dim caption As String
 Dim send As String
 If Len(dfn) Then
  caption = "caption"
  Select Case LCase(pavd)
  Case "photo", "animation", "audio", "voice", "video", "document"
   send = LCase(pavd)
  Case Else
   dfnA = Split(LCase(dfn), ".")
   Select Case dfnA(UBound(dfnA))
   Case "jpg", "jpeg", "png"
    send = "photo"
   Case "gif", "apng"
    send = "animation"
   Case "mp4"
    send = "video"
   Case "mp3", "m4a"
    send = "audio"
   Case "ogg"
    send = "voice"
   Case Else
    send = "document"
   End Select
  End Select
 Else
  caption = "text"
  send = "message"
 End If
 part = part & form(caption) & text
 Dim file
 Dim body
 With CreateObject("ADODB.Stream")
  If Len(dfn) Then
   ' filename
   part = part & bond() & form(send, dfn)
   ' read file as binary
   .Mode = adModeReadWrite
   .Type = adTypeBinary
   .Open
   .LoadFromFile filename
   .Position = 0
   file = .Read
   .Close
  End If
 ' combine part, file , end
  .Type = adTypeBinary
  .Open
  .Position = 0
  .Write ToBytes(part)
  'Debug.Print part
  If Len(dfn) Then .Write file
  .Write ToBytes(bond(suff:="--"))
  .Position = 0
  body = .Read
  .Close
 End With
 With CreateObject("MSXML2.XMLHTTP")
  'Debug.Print telegram & Token & "/send" & StrConv(send, vbProperCase)
  .Open "POST", telegram & Token & "/send" & StrConv(send, vbProperCase), False
  .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & bond("", "")
  .send body
  tmBotSend = .responseText
  'Debug.Print .responseText
 End With
End Function

Function ToBytes(str As String) As Variant
 Const adTypeBinary = 1
 Const adTypeText = 2
 Const adModeReadWrite = 3
 With CreateObject("ADODB.Stream")
  .Mode = adModeReadWrite
  .Type = adTypeText
  .Charset = "UTF-8" '"_autodetect"
  .Open
  .WriteText str
  .Position = 0
  .Type = adTypeBinary
  ToBytes = .Read
  .Close
 End With
End Function

Private Function bond(Optional pref As String = vbCrLf & "--", Optional suff As String = vbCrLf, Optional BOUNDARY As String = "--OYWFRYGNCYQAOCCT44655,4239930556") As String
 bond = pref & BOUNDARY & suff
End Function

Private Function form(ByVal name As String, Optional ByVal filename As String = "") As String
 form = "Content-Disposition: form-data; name=""" & name & """"
 If Len(filename) Then form = form & "; filename=""" & filename & """"
 form = form & vbCrLf & vbCrLf
End Function
    Login or Signup to reply.
Please signup or login to give your own answer.

Back To Top
Search