i want to pass byte[] from excel vba to web service.
Below is the code which will convert file to byte[].
Dim bytFile() As Byte
bytFile = GetFileBytes("C:\test.doc")
below code is used to call webservice. bytFile is my parameter
Dim XMLHttp As Object: Set XMLHttp = CreateObject("Microsoft.XMLHTTP")
XMLHttp.Open "POST", Service + "/PassExcelData", False
XMLHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
XMLHttp.send "filebyte=" & bytFile
But i am not able to pass it to webservice. i am getting error at last line. So i just want to is it possible? If not, which way i can achieve this?
I have also tried below code
Function FileToStr(ByVal strFile As String) As String
Dim hFile As Long
hFile = FreeFile
Open strFile For Input As #hFile
FileToStr = Input$(LOF(hFile), hFile)
Close #hFile
End Function
and called it as:
XMLHttp.send "filebyte=" & FileToStr(file path).
but it returned the below error:
You can't append a byte array with & operator. get the text of the file using
use this function
Function FileToStr(ByVal strFile As String) As String
Dim hFile As Long
hFile = FreeFile
Open strFile For Input As #hFile
FileToStr = Input$(LOF(hFile), hFile)
Close #hFile
End Function
and then do
XMLHttp.send "filebyte=" & FileToStr("Path to your file")
You can comment out the GetFileBytes line
Related
I try to upload a file (POST request) to a web service through their API in VBA. I get an "out of memory error" if the file is too large.
Unfortunately the web service does not support chunked transfer (which seems to be deprecated since http/2 anyway). Is there a way to "stream" the file without loading it into memory at once before sending?
I would like to avoid calling curl.exe, because it's cleaner.
Dim url As String
Dim dataStream As Object
Const adTypeBinary = 1
url = "https://api-endpoint.domain.com"
Dim oWinHttpReq As Object
Set oWinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
With oWinHttpReq
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/octet-stream"
.setRequestHeader "Authorization", "Bearer " & AUTH_TOKEN
Set dataStream = CreateObject("ADODB.Stream")
dataStream.Type = adTypeBinary
dataStream.Open
dataStream.LoadFromFile filePath
.send dataStream.Read
End With
I tried Win32 file API as well but cannot transfer the output to the HTTP post.
/edit: I think I came closer. The solution seems to be chunked transfer - by setting the Header "Transfer-Encoding" to "chunked". Looks like you have to handle the chunk structure yourself because WinHTTP 5.1 does only support chunked download, not chunked upload. How do I use the winhttp api with "transfer-encoding: chunked"
But when I set the "Transfer-Encoding" Header, the .send method does not seem to be present anymore
/edit: I developed this function with the help of ChatGPT, but the HttpSendRequest fails...
Public Sub UploadFileChunkedLarge(filePath As String, url As String)
Dim CHUNK_SIZE As Long
CHUNK_SIZE = CLng(1024) * CLng(1024) ' 1 MB
Dim hSession As Long
Dim hRequest As Long
Dim hConnection As Long
Dim lngRetVal As Long
Dim strBoundary As String
Dim strPost As String
Dim strHeader As String
Dim varData() As Byte
Dim lngIndex As Long
Dim lngSize As Long
Dim lngBytesRead As Long
Dim result As Boolean
' Set the boundary for the POST data
strBoundary = "---------------------------7d93b2a700d04"
' Open the file for binary access
Open filePath For Binary Access Read As #1
' Get the file size
lngSize = LOF(1)
' Create the session
hSession = InternetOpen("Upload", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
' Create the request
hConnection = InternetConnect(hSession, url, INTERNET_DEFAULT_HTTP_PORT, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
' HttpOpenRequest hRequest, "POST", "", "HTTP/1.1", "", "", INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_NO_AUTH, 0
hRequest = HttpOpenRequest(hConnection, "POST", "", "HTTP/1.1", "", "", INTERNET_FLAG_NO_CACHE_WRITE, 0)
' Add the headers
strHeader = "Content-Type: multipart/form-data; boundary=" & strBoundary & vbCrLf
strHeader = strHeader & "Authorization: Bearer " & KDRIVE_TOKEN & vbCrLf
strHeader = strHeader & "Content-Length: " & lngSize & vbCrLf & vbCrLf
result = HttpAddRequestHeaders(hRequest, strHeader, Len(strHeader), HTTP_ADDREQ_FLAG_ADD)
Debug.Print WININET_GetLastError
' Send the request
result = HttpSendRequest(hRequest, vbNullString, 0, vbNullString, 0)
Debug.Print WININET_GetLastError
' Send the file data in chunks
Do While Not EOF(1)
' Read the next chunk of data
ReDim varData(CHUNK_SIZE)
lngBytesRead = LOF(1) - Loc(1)
If lngBytesRead > CHUNK_SIZE Then
lngBytesRead = CHUNK_SIZE
End If
Get #1, , varData
' Send the chunk
result = InternetWriteFile(hRequest, varData(0), lngBytesRead, lngIndex)
Loop
' Close the file
Close #1
' Close the request
InternetCloseHandle hRequest
' Close the session
InternetCloseHandle hSession
End Sub
This question already has an answer here:
Convert CURL command line to VBA
(1 answer)
Closed 2 years ago.
I'm trying to upload a tiny text file in a website using vba. When I run the script I encounter this error {"success":false,"error":400,"message":"Trouble uploading file"}. I mimicked the same approach using vba that I did and found success using python. I got rid of the headers altogether in python so I suppose multipart headers is not that important to upload the file successfully.
Using vba (I got the above error):
Sub UploadFile()
Dim Http As New XMLHTTP60, sPostData$
Dim nFile&, baBuffer() As Byte
nFile = FreeFile
Open "C:\Users\WCS\Desktop\some_text.txt" For Binary Access Read As nFile
If LOF(nFile) > 0 Then
ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
Get nFile, , baBuffer
sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
' MsgBox sPostData 'to examine if it is able to print the text
With Http
.Open "POST", "https://file.io/"
.setRequestHeader "x-requested-with", "XMLHttpRequest"
.send ("file=" & sPostData)
Debug.Print .responseText
End With
End Sub
Using vba (another way but got the same error):
Sub UploadFile()
Dim Http As New XMLHTTP60, sPostData$
With CreateObject("ADODB.Stream")
.Charset = "utf-8"
.Open
.LoadFromFile ("C:\Users\WCS\Desktop\some_text.txt")
sPostData = .ReadText()
End With
With Http
.Open "POST", "https://file.io/"
.setRequestHeader "x-requested-with", "XMLHttpRequest"
.send ("file=" & sPostData)
Debug.Print .responseText
End With
End Sub
Using python (I got success):
import requests
url = 'https://file.io/'
files = {
'file': open('some_text.txt','rb')
}
def upload_file(link):
res = requests.post(link,files=files)
print(res.content)
if __name__ == '__main__':
upload_file(url)
Btw, this is what the text file contains hi there!!!
If the file was textfile, you can store the contents in a variable and in this case to send the contents as text
Sub UploadFile()
Dim http As New XMLHTTP60, sPostData$
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile (ThisWorkbook.Path & "\Sample.txt")
sPostData = .ReadText()
End With
With http
.Open "POST", "https://file.io"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send ("text=" & sPostData)
Debug.Print .responseText
End With
End Sub
The code depends on the code derived from this LINK
I send messages form Excel to telegram. It works nice.
But how can I send a photo? I don't understand it (https://core.telegram.org/bots/api#sendphoto)
Thanks for help!
My send Message:
Dim objRequest As Object
Dim strChatId As String
Dim strMessage As String
Dim strPostData As String
Dim strResponse As String
strChatId = Worksheets("Einstellungen").Cells(3, "AB")
strMessage = Report
APIcode = Worksheets("Einstellungen").Cells(2, "AB")
strPostData = "chat_id=" & strChatId & "&text=" & strMessage
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/" & APIcode & "/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
GetSessionId = .responseText
End With
If your code is working as-is for plain text messages then you should only need to make a couple changes to it.
You're probably currently using the API's sendMessage method, which takes the chat_id and text parameters.
You want to use the sendPhoto method, which tales the chat_id and photo parameters (but no text parameter).
So this is a bit of a shot in the dark since I've never used or heard of Telegram and I don't have a key, so I can't test it, but theoretically, you could send a photo from a URL like this:
Sub telegram_SendPhoto()
Const photoURL = "https://i.imgur.com/0eH6d1v.gif" 'URL of photo
Dim objRequest As Object, strChatId As String, APIcode As String
Dim strPostData As String, strResponse As String
strChatId = Worksheets("Einstellungen").Cells(3, "AB")
APIcode = Worksheets("Einstellungen").Cells(2, "AB")
strPostData = "chat_id=" & strChatId & "&photo=" & photoURL
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/" & APIcode & "/sendPhoto?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
strResponse = .responseText
End With
MsgBox strResponse
End Sub
Pass a file_id as String to send a photo that exists on the Telegram servers (recommended), pass an HTTP URL as a String for Telegram to get a photo from the Internet (above), or upload a new photo using multipart/form-data. More info on Sending Files ยป
I need to make status message on excel after calling the api . status message in xml format so how to parse the data accurately.
Below given codes are using to get API info
Sub Test()
Dim xmlHTTP As Object
Set xmlHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
myURL = "http://xxxxxxxxxxxxx:15555/gateway/StatusTracking/1.0/shipment/tracking?housebill=cvvvv"
xmlHTTP.Open "GET", myURL, False
xmlHTTP.SetRequestHeader "APIKey", "xxxx-xxx-xxxxx-xxxx-xxxx"
xmlHTTP.SetRequestHeader "Accept", "application/json"
xmlHTTP.Send
Dim strReap As String
strReap = hReq.ResponseText
Dim xmlDoc As New MSXML2.DOMDocument
If Not xmlDoc.LoadXML(strReap) Then
MsgBox "Load error"
End If
Dim xnodelist As MSXML2.IXMLDOMNodeList
Set xnodelist = xmlDoc.getElementsByTagName("ShipmentTracking")
Dim xnode As MSXML2.IXMLDOMNode Set xnode = xnodelist.Item(0)
Dim obAtt1 As MSXML2.IXMLDOMAttribute
Dim obAtt2 As MSXML2.IXMLDOMAttribute
Dim xChild As MSXML2.IXMLDOMNode
Dim intRow As Integer
intRow = 2
Dim strCol1 As String
strCol1 = "A"
Dim strCol2 As String
strCol1 = "B"
Dim Shipment As String
For Each xChild In xnode.ChildNodes
Set obAtt1 = xChild.Attributes.getNamedItem("Shipment")
ws.Cells(intRow, 2) = obAtt1
intRow = intRow + 1
Next xChild
Set hReq = Nothing
Set xmlDoc = Nothing
End Sub
normal xml status message format given below
<Shipment tracking>
<type/>
<object/>
<properties/>
<Shipment>
<Origin/>
<type/>
<properties/>
<LocationCode/>
<CountryCode/>
</Shipment>
</Shipment tracking>
I am newbie in vba programming and i tried with this code but not working fine. I just want output,from shipment(xmltagname) to end in excel sheet. Please help me on this
You have written code Attributes.getNamedItem when in fact you have no attributes. Also to query for elements I'd prefer selectNodes and selectSingleNode instead of getElementsByTagName.
So try
xChild.selectSingleNode("Shipment")
and change the declaration for the receiving variable from IXMLDOMAttribute to IXMLDOMElement
I want to click on the following link
I have the class name and the line code I was trying ot use is the following:
objIE.document.getElementByClassName("msDataText searchLink").Click
This may well be a very basic question.. any guidance
Thanks a lot
Not sure if it is a duplicate question.
A good function GetHTTPResult is already available from the link. You need to just pass the url for the GET request to fetch the data. For POST request (this function will not work), you need to make a POST request with postdata.
Also there is a sample for XMLHttpRequest at link
Function GetHTTPResult(sURL As String) As String
Dim XMLHTTP As Variant, sResult As String
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
XMLHTTP.Open "GET", sURL, False
XMLHTTP.Send
Debug.Print "Status: " & XMLHTTP.Status & " - " & XMLHTTP.StatusText
sResult = XMLHTTP.ResponseText
Debug.Print "Length of response: " & Len(sResult)
Set XMLHTTP = Nothing
GetHTTPResult = sResult
End Function