Currently I'm trying to write a function to post data to an IE window in VBS. I'm trying to modify a function I wrote in VBA which works well:
Sub IEPostStringRequest(URL As String, FormData As String, WebBrowser As InternetExplorer, TargetName As String)
'Send the form data To URL As POST request
Dim bFormData() As Byte
ReDim bFormData(Len(FormData) - 1)
bFormData = StrConv(FormData, vbFromUnicode)
WebBrowser.Navigate URL, 2 + 4 + 8, TargetName, bFormData, _
"Content-type: application/x-www-form-urlencoded" + Chr(10) + Chr(13)
WebBrowser.Navigate
End Sub
You send it a URL, query string as FormData, an InternetExplorer object which already exists, and a target frame and it sends the post request to that frame. However, StrConv doesn't work in VBS and I haven't found a suitable replacement for it. It also seems like there must be a better way, because sending a post request is fairly simple. What should I do?
Try ADODB.Stream ActiveX to convert string to binary array of bytes:
With CreateObject("ADODB.Stream")
.Open
.Type = 2 ' adTypeText
.Charset = "us-ascii"
.WriteText FormData
.Position = 0
.Type = 1 ' adTypeBinary
bFormData = .Read
.Close
End With
Related
I'm trying to use the Qrickt API:
https://qrickit.com/qrickit_apps/qrickit_api.php
to create a QRCode for Google Map address in VBA.
To do this I have to send a Http request like this:
"http://qrickit.com/api/qr.php?d=http://google.com/maps?q=Via+Roma,+1+Milano&qrsize=150&t=p&e=m"
The API documentation says:
*For non-English and special characters, url encode your data first.
The problem is that I cannot manage to pass an encoded address to the API.
If I pass a string such as "Via+Roma", or "Via%20Roma", the generated QRCode URL is always
http://maps.google.com/maps?q=Via Roma, 1 Milano
so the QRCode image is created, but phone do not open directly google maps.
Can somehome help me?
Here's the code:
Public Function f_QRCode(ByVal Address As String, ByVal Destination As String) As Boolean
On Error GoTo Err_Handler
Const ApiPath As String = "https://qrickit.com/api/qr.php?d=http://maps.google.com/maps?q="
Dim WinHttpReq As Object '\\ Oggetto che serve al download del verbale
Dim fic As Integer
Dim buffer() As Byte
Dim URL As String
'\\ Costruisco l'URL
URL = ApiPath + "Via%20Roma%2C%%201%20Milano" + "&qrsize=150&t=p&e=m"
'\\ Creo l'oggetto per la connessione
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
WinHttpReq.Open "POST", URL, False
WinHttpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
fic = FreeFile
Open Destination For Binary Lock Read Write As #fic
buffer = WinHttpReq.responseBody
Put #fic, , buffer
Close #fic
f_QRCode = True
Else
MsgBox "Error"
End If
ExitHere:
Erase buffer
Set WinHttpReq = Nothing
Exit Function
Err_Handler:
Resume ExitHere
End Function
Their API accepts GET requests, and you're sending a POST.
Try:
URL = ApiPath + "Via%20Roma%2C%%201%20Milano" + "&qrsize=150&t=p&e=m"
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send
I would add that you might consider using the function EncodeURL for encoding.
Application.EncodeURL("url")
Here is a piece of code that should connect to a web page with contents as follows: link1, description1, otherdata1, link2, description2, otherdata2, ..., linkN, descriptionN, otherdataN where N is 30 000 +.
From these links, the program finds one link of interest using regex, goes to that link, and downloads a file from there.
My problem is: at htmlWebInterfaceXML.send the program frequently, but not always, runs out of memory ('out-of-memory' error). It is difficult for me to test different solutions because normally the program runs smoothly, and it is difficult to notice changes if any.
Additional info:
It runs smoothly on some PCs and does not work for others
It usually runs until afternoon and throws an error then
Other infos that may be helpful:
the code shown is a private method of class and the class itself is a small part of the source code
other subs called which I do not explain are not relevant and run smoothly, the probelm always appears at htmlWebInterfaceXML.send.
One guess of mine is that I have declared local variable inside of a function that holds a very large object and can cause a stack overflow but it seems unlikely as VBA should handle those things on its own. Maybe you see a problem that I don't? Thank you.
Private Sub FileUpload()
' THE FUNCTION CANNOT BE CONNECTING FOR EACH CONTRACT ID! WILL TAKE TOO MUCH TIME - NEED TO ALTER
Dim member As Variant
Dim byteCounter As Byte
Dim byteMaxID As Byte
Dim strPathToXMLFile As String
Dim strURLToXMLFile
Dim strXMLFileStorageName As String
Dim domdocXMLText As New MSXML2.DOMDocument
Dim clctStrFoundMatches As New Collection
Dim clctInternalIDs As New Collection
Dim vrntContractID As Variant
Dim htmlHTMLMainPageXMLInterface As New MSHTML.HTMLDocument
Dim htmlTagElement As Variant
Dim htmclctFoundXMLs As MSHTML.IHTMLElementCollection
Dim htmlWebInterfaceXML As MSXML2.XMLHTTP60
Dim intNumberOfTradeUnderProcessing As Integer
UpdateProgressStatus "LOADING SERVER WITH SOURCE XML..." '<----------- UPDATE PROGRESS!
'----------------------> OPEN AND LOAD THE WEB SERVER, AND STORE ITS HTML INTO AN OBJECT
Set htmlWebInterfaceXML = New MSXML2.XMLHTTP
With htmlWebInterfaceXML
.Open "GET", p_cstrWebInterfaceXMLRootDirectory, False
.setRequestHeader "Authorization", "Basic" & Base64Encode( _
p_cstrXMLWebInterfaceAuthenticationUser & ":" & p_cstrXMLWebInterfaceAuthenticationPassword)
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
End With
htmlHTMLMainPageXMLInterface.body.innerHTML = htmlWebInterfaceXML.responseText ' how much text is the htmldocument able to store??
Set htmlWebInterfaceXML = Nothing
SetUpDirectory ' ------------> create or set directory where to store XML files
If Me.ContractiDs.Count <> Me.MailParts.Count And Me.ContractiDs.Count <> Me.MailParts.Count * 2 Then
Err.Raise 1504, "FileUpload", p_cstrError1504Message
Else
For Each vrntContractID In Me.ContractiDs
intNumberOfTradeUnderProcessing = intNumberOfTradeUnderProcessing + 1
UpdateProgressStatus "LOADING XML FOR THE TRADE NUMBER " & intNumberOfTradeUnderProcessing & "..." ' ----------------> UPDATE STATUS BAR
' ------------------------> find the tags containing the needed contract id in their names
Set htmclctFoundXMLs = htmlHTMLMainPageXMLInterface.getElementsByTagName("a")
Set clctStrFoundMatches = New Collection
For Each htmlTagElement In htmclctFoundXMLs
If htmlTagElement.getAttribute("href") Like "*" & vrntContractID & "*" Then
clctStrFoundMatches.Add htmlTagElement
End If
Next htmlTagElement
If clctStrFoundMatches.Count = 0 Then Err.Raise 1506, "FileUpload", p_cstrError1506Message
' -----------------------> exclude the archives from the collection
byteCounter = 0
For byteCounter = 1 To clctStrFoundMatches.Count
If blnContainsPattern("\.gz$", clctStrFoundMatches(byteCounter).innerText) Then
clctStrFoundMatches.Remove byteCounter
End If
Next byteCounter
' ----------------------> extract the contract ids and find the last contract id
Set clctInternalIDs = New Collection
For Each member In clctStrFoundMatches
clctInternalIDs.Add strReturnSingleMatch("\d{9}", member.innerText)
If clctInternalIDs(clctInternalIDs.Count) = "False" Then Err.Raise 1505, "FileUpload", p_cstrError1505Message
Next member
byteMaxID = FindMaximum(clctInternalIDs)
strPathToXMLFile = clctStrFoundMatches(byteMaxID).innerText
' -----------------------> check whether such file exists, and, if not, download it
If blnFileExists(strPathToXMLFile, p_cstrXMLDestination) Then
Else
strURLToXMLFile = p_cstrWebInterfaceXMLRootDirectory & strPathToXMLFile
Set htmlWebInterfaceXML = Nothing: Set htmlWebInterfaceXML = New MSXML2.XMLHTTP
htmlWebInterfaceXML.Open "GET", strURLToXMLFile, False
htmlWebInterfaceXML.setRequestHeader "Authorization", "Basic" & Base64Encode( _
p_cstrXMLWebInterfaceAuthenticationUser & ":" & p_cstrXMLWebIntervaceAuthenticationPassword)
htmlWebInterfaceXML.send
With domdocXMLText
.validateOnParse = False
.async = False
End With
domdocXMLText.LoadXML htmlWebInterfaceXML.responseText
domdocXMLText.Save p_cstrXMLDestination & "\" & strPathToXMLFile
End If
Next vrntContractID
End If
Set htmlHTMLMainPageXMLInterface = Nothing
End Sub
I had a similar problem that i solved. my script ran through a server and looked for a string in thousands of text files.
The way i solved it is (using ascync ServerXMLHTTP60) setting an if condition in the response handler to ABORT the xmlhttp object. After i was done comparing data, the object would get "dropped" out of memory, and now i can query (virtually) any amount of data. (took me about a month to test a lot of solution, and this was the right one)
This might work for you, so just add htmlWebInterfaceXML.abort after you are done with that data set.
Hope this helps! Cheers!
I am trying to understand the file upload process using vba and winhttp.
I am trying to upload files to:
https://uploadfiles.io/
Using the following code in VBA:
Public Function GetFileBytes(ByVal path As String) As Byte()
Dim lngFileNum As Long
Dim bytRtnVal() As Byte
lngFileNum = FreeFile
If LenB(Dir(path)) Then ''// Does file exist?
Open path For Binary Access Read As lngFileNum
ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte
Get lngFileNum, , bytRtnVal
Close lngFileNum
Else
Err.Raise 53
End If
GetFileBytes = bytRtnVal
Erase bytRtnVal
End Function
Sub testLoad()
Dim http
Dim filedata() As Byte
filedata = GetFileBytes("C:\apps\somefile.pdf")
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://uploadfiles.io/upload"
http.Open "POST", URL, False
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=---------------------------7e1881e4703b8" 'Add boundary
http.setRequestHeader "Content-Length", 80047 'Add length
http.send filedata
MsgBox http.Status
End Sub
I am a pretty big noob working with the web and winhttp. Using this code I get a successful 200 response... I think. But I have no idea where the file is now that it is uploaded. So here are my questions:
1.) Where and how do I set the file information as it is being uploaded?
2.) What exactly is the "boundary=" in the requestHeader? I manually set this by watching the network traffic, but I don't know what it means.
3.) What is the length in the requestHeader? Can I use len(filedata)
Any help would be greatly appreciated, thank you.
I want to import data from Anedot, a credit card processing firm, using a HTTP GET request from an MS Access program. Anedot uses a RESTful API and has provided help on there website: https://anedot.com/api/v2
I want to do this with VBA, and associate the import with a button on an MS Access form. I've read that this only possible with XML. Do I create the XML file with VBA?
I'd greatly appreciate some background information on how to get this done, as most of it is flying over my head. I don't really know where to begin and I'm having trouble finding anything useful on google.
So far I've realized I'll need to reference their API via a URL link (which they provide), and that I'll have to authorize my account using my username and a token ID. But how can I do this in VBA?
Thanks.
First of all try to make a request to API using basic authorization. Take a look at the below code as the example:
Sub Test()
' API URL from https://anedot.com/api/v2
sUrl = "https://api.anedot.com/v2/accounts"
' The username is the registered email address of your Anedot account
sUsername = "mymail#example.com"
' The password is your API token
sPassword = "1e56752e8531647d09ec8ab20c311ba928e54788"
sAuth = TextBase64Encode(sUsername & ":" & sPassword, "us-ascii") ' bXltYWlsQGV4YW1wbGUuY29tOjFlNTY3NTJlODUzMTY0N2QwOWVjOGFiMjBjMzExYmE5MjhlNTQ3ODg=
' Make the request
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", sUrl, False
.SetRequestHeader "Authorization", "Basic " & sAuth
.Send
Debug.Print .ResponseText
Debug.Print .GetAllResponseHeaders
End With
End Sub
Function TextBase64Encode(sText, sCharset) ' 05 10 2016
Dim aBinary
With CreateObject("ADODB.Stream")
.Type = 2 ' adTypeText
.Open
.Charset = sCharset ' "us-ascii" for bytes to unicode
.WriteText sText
.Position = 0
.Type = 1 ' adTypeBinary
aBinary = .Read
.Close
End With
With CreateObject("Microsoft.XMLDOM").CreateElement("objNode")
.DataType = "bin.base64"
.NodeTypedValue = aBinary
TextBase64Encode = Replace(Replace(.Text, vbCr, ""), vbLf, "")
End With
End Function
Put your credentials to sUsername and sPassword variables, choose the appropriate URL from API help page and put it to sURL. Then you can parse JSON response from the server (currently you will see the response for /v2/accounts request in Immediate window).
It's a fairly lengthy question to be honest, but lets start with some code to get you going.
This Class Module ("clsXMLHttpMonitor") should help:
Option Explicit
Dim XMLHttpReq As MSXML2.ServerXMLHTTP
Dim RequestedVar As String
Dim P As Object
Public Sub Initialize(ByVal uXMLHttpRequest As Object, Optional RequestedValue As String = "")
RequestedVar = RequestedValue
Set XMLHttpReq = uXMLHttpRequest
End Sub
Sub ReadyStateChangeHandler()
If XMLHttpReq.ReadyState = 4 Then
If XMLHttpReq.Status = 200 Then
'Process the response here
Debug.Print "200 recieved"
Set P = JSON.parse(XMLHttpReq.responseText)
Else
If XMLHttpReq.Status = 404 Then
'Handle it
End If
End If
End If
End Sub
Function returnResponseHeaders() As String
returnResponseHeaders = XMLHttpReq.getAllResponseHeaders
XMLHttpReq.Send
End Function
Function returnFullText() As String
If XMLHttpReq.ReadyState = 4 Then
If XMLHttpReq.Status = 200 Then
returnFullText = XMLHttpReq.responseText
Else
returnFullText = "-1"
End If
Else
returnFullText = ""
End If
End Function
End Function
Use it like this:
Set XMLHttpReq = New MSXML2.ServerXMLHTTP
Set XMLHttpMon = New clsXMLHttpMonitor
XMLHttpMon.Initialize XMLHttpReq
XMLHttpReq.OnReadyStateChange = XMLHttpMon
XMLHttpReq.Open "POST", URL, True
XMLHttpReq.Send strPayload
As you seem to request a Json response from a URL, you can study the Json modules here for a full implementation that collects the Json response in a collection, which you then can use in your code or save to a table. See the demo module for examples:
VBA.CVRAPI
I've been trying to upload file to Azure storage using VBA in Microsoft Access but so far without success.
I have had a good search around and have found some code which looks promising but I can't get it to work. Seems like many others have been looking for a similar solution or help with working with Azure from VBA.
This is the code;
Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String
Const STR_BOUNDARY As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim nFile As Integer
Dim baBuffer() As Byte
Dim sPostData As String
'--- read file
nFile = FreeFile
Open sFileName 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
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", sUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.Send pvToByteArray(sPostData)
If Not bAsync Then
pvPostFile = .ResponseText
End If
End With
End Sub
Private Function pvToByteArray(sText As String) As Byte()
pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
(Thanks to - https://wqweto.wordpress.com/2011/07/12/vb6-using-wininet-to-post-binary-file/)
When I try this code using my azure storage URL in the form
https://XXXXX.blob.core.windows.net/
and a filename (C:\Temp\Test.txt) I get the following error;
<?xml version="1.0" encoding="utf-8"?><Error><Code>UnsupportedHttpVerb</Code><Message>The resource doesn't support specified Http Verb.
I suspect there's a problem in the header or post data rather than the VBA and this is not really my area.
Any help greatly appreciated.
I came across this post as I'm searching the same answer for uploading images to Azure Blob Storage. I took me 2 days to get the answer. And the code posted above did help me to partly solve the problem.
I would like to post my solution here in case anyone else is looking for the same answer.
Before you can use the code below, you need to get the Shared Access Signature (SAS) from your Azure portal (manage panel). You should be able to google the answers on this.
Public Sub UploadAfIle(sUrl As String, sFileName As String)
Dim adoStream As Object
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Mode = 3 ' read write
adoStream.Type = 1 ' adTypeBinary
adoStream.Open
adoStream.LoadFromFile (sFileName)
With CreateObject("Microsoft.XMLHTTP")
adoStream.Position = 0
.Open "PUT", sUrl, False
.setRequestHeader "Content-Length", "0" 'this is not a must
.setRequestHeader "x-ms-blob-type", "BlockBlob"
.Send adoStream.Read(adoStream.Size)
End With
Set adoStream = Nothing
End Sub
sURL is a URL looks like (I'm in China so the Host is different): https://myaccount.blob.core.chinacloudapi.cn/products/newimagename.jpg?sv=2016-05-31&ss=bfpq&srt=dco&sp=rydlscup&se=2017-07-30T18:40:26Z&st=2017-07-28T10:40:26Z&spr=https&sig=mJgDyECayITp0ivVrD4Oug%2Bz%2chN7Wpo2nNtcn0pYRCU%4d
The one bolded is the SAS token you generated from Azure.
Worth noting the format of the sUrl in SiliconXu's answer is made up of 3 parts, I didn't realise at first so got a sore head for a while!!
1) Azure blob container URL (from the properties in the Storage Explorer)
2) the filename (this is the part I omitted by mistake)
3) Shared Access Signature
So is built like this
sURL = destination_folder & "/" & local_file_name & "?" & conn_SAS
I don't have the reputation require to comment directly below that answer
Great code though, as soon as I worked out the format of the sURL it worked like a dream
Azure Storage Service uses private key authentication. Since VBA runs on the end user's machine you are exposing yourself to a whole slew of risks associated with that key getting into the wild. I would recommend rethinking the whole premise of going directly from VBA to Azure Storage and utilize your own WebAPI to handle storing data to Blob.
This would have the dual benefit of:
1) making it easier to integrate with from VBA and
2) protecting your Azure Storage private key behind a component of your solution that doesn't get deployed to the end user's machine.