XmlHttp Post in Excel VBA not updating website form - vba

I routinely have to search the state of NV for unclaimed property and put the results in an Excel spreadsheet. I am trying to automate the process but I'm limited to using Excel 2010 and VBA. Below is the URL to the site I'm trying to submit a form using xmlhttp.
URL: https://nevadatreasurer.gov/UPSearch/
I created a class to automate submitting forms on other websites but no matter what I enter in the postdata the form is never submitted. Below is my submission, and method to submit the form.
Call to class:
cXML.openWebsite "Post", "https://nevadatreasurer.gov/UPSearch/Index.aspx", _
"ctl04$txtOwner=" & strSearchName
Class method:
Public Sub openWebsite(strOpenMethod As String, strURL As String, _
Optional strPostData As String)
pXmlHttp.Open strOpenMethod, strURL
If strPostData <> "" Then
strPostData = convertSpaceToPlus(strPostData)
pXmlHttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
pXmlHttp.send (strPostData)
Else
pXmlHttp.send
End If
'Create DOM html documnet
pHtmlObj.body.innerHTML = pXmlHttp.responseText
End Sub
Each time the responseText is the main website with no updates, as if I submitted no postdata. I'm fairly new to IE automation but can someone provide a reason why this isn't working and a code example that works?
Thanks!
Update: 7/26/13 8:30am PST
Without any changes to my method I was able to submit forms through another website. The state of OR unclaimed property form. It worked perfect!
URL: https://oregonup.us/upweb/up/UP_search.asp
However I ran into the same problem when I tried the state of CA unclaimed property website. No matter what I do, the responseText is always the original search page with no update.
URL: https://scoweb.sco.ca.gov/UCP/Default.aspx
It still does not work with the state of NV on my original post. I am using the proper post data, URL encoded for each website and can see no difference. Any help would be appreciated.

Try below code
Public Sub openWebsite(strOpenMethod As String, strURL As String, Optional strPostData As String)
Dim pXmlHttp As Object
Set pXmlHttp = CreateObject("MSXML2.XMLHTTP")
pXmlHttp.Open strOpenMethod, strURL, False
pXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
pXmlHttp.send (strPostData)
Dim pHtmlObj As Object
Set pHtmlObj = CreateObject("htmlfile")
pHtmlObj.body.innerHTML = pXmlHttp.ResponseText
MsgBox pXmlHttp.ResponseText
End Sub
Sub test()
Dim btnSearch As String, strSearchType As String, strSearchName As String, PostData As String
btnSearch = "Search"
strSearchType = "Owner"
strSearchName = "Santosh"
PostData = "ctl04%24txtOwner=" & strSearchName & "&ctl04%24btnSearch=" & btnSearch & "&ctl04%24rblSearchType=" & strSearchType
openWebsite "POST", "https://nevadatreasurer.gov/UPSearch/Index.aspx", PostData
End Sub
Post Data view using Firebug
URL encode
ResponeText

You should urlencode the characters in this string:
"ctl04$txtOwner=" & strSearchName
Ways to do this are discussed here: SO link, as VBA doesn't have a built-in function for this.
The dollar sign needs to be replaced with %24 and any spaces with %20. If these are the only non-alphanumeric characters in the string they you could take a simple approach, using VBA.Replace() (twice). You are currently replacing spaces with '+' which will usually work, but the dollar-sign may be an issue.

Related

Parse and access deepl.com API response with VBA

I have a VBA function which retrieves data from the deepl.com API (translation).
Private Function Translate_Text(INPUT_TEXT As String) As String
Dim apiKey As String
Dim textToTranslate As String
Dim fromLanguage As String
Dim toLanguage As String
Dim request As New MSXML2.XMLHTTP60
Dim response As New MSHTML.HTMLDocument
' Set my API key here
apiKey = myAPIKey
' Get the text to translate from a text box
textToTranslate = INPUT_TEXT
' Set the languages to translate from and to
fromLanguage = "en"
toLanguage = "de"
' Send the request to the DeepL API
request.Open "POST", "https://api-free.deepl.com/v2/translate?", False
request.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
request.Send "auth_key=" & apiKey & "&text=" & textToTranslate & "&source_lang=" & fromLanguage & "&target_lang=" & toLanguage
' Parse the response from the API
response.body.innerHTML = request.responseText
Debug.Print request.responseText
This print shows that the request itself was successful:
{"translations":[{"detected_source_language":"EN","text":"Steigerung der Benutzereffizienz"}]}
I then try to access the "text" element:
translatedText = response.getElementsByTagName("text")(0).innerText
However this throws an error ("Object variable or with block variable not defined")
So my question is how I can correctly access the text in the response object.
The request you get from the API is JSON formatted, not HTML.
You can not use getElementsByTagName on JSON that's why it always says its empty.
You would need to use something like VBA-JSON (as suggested by Tim Williams above). https://github.com/VBA-tools/VBA-JSON
When using VBA-JSON you can do something like this:
Dim Json As Object
Set Json = JsonConverter.ParseJson(request.responseText)
Debug.Print Json.text

Catch the POST Request Response and the Redirected URL from XMLHTTP request with VBA

I'm trying to catch a Response to a POST Request using XMLHTTP using the code below
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim htmlEle1 As MSHTML.IHTMLElement
Dim htmlEle2 As MSHTML.IHTMLElement
Dim URL As String
Dim elemValue As String
URL = "https://www.informadb.pt/pt/pesquisa/?search=500004064"
XMLPage.Open "GET", URL, False
XMLPage.send
HTMLDoc.body.innerHTML = XMLPage.responseText
For Each htmlEle1 In HTMLDoc.getElementsByTagName("div")
Debug.Print htmlEle1.className
If htmlEle1.className = "styles__SCFileModuleFooter-e6rbca-1 kUUNkj" Then
elemValue = Trim(htmlEle1.innerText)
If InStr(UCase$(elemValue), "CONSTITU") > 0 Then
'Found Value
Exit For
End If
End If
Next htmlEle1
The problem is that I can't find the ClassName "styles__SCFileModuleFooter-e6rbca-1 kUUNkj", because I notice that when I manually insert the value (500004064) in the search box of the URL : https://www.informadb.pt/pt/pesquisa/, the Web Page generates addicinal traffic and turns up at an end point URL : https://www.informadb.pt/pt/pesquisa/empresa/?Duns=453060832, where that className can be found in the Request ResponseText.
My goal is to use the First URL to retrieve the Duns number '453060832', to be able to access the information in the ResponseText of the EndPoint URL. And to catch Duns Number, I need to find a way to get the Endpoint URL, or try to get The POST request response below, and get that value using JSON parser:
{'TotalResults': 1,
'NumberOfPages': 1,
'Results': [{'Duns': '453060832',
'Vat': '500004064',
'Name': 'A PANIFICADORA CENTRAL EBORENSE, S.A.',
'Address': 'BAIRRO DE NOSSA SENHORA DO CARMO,',
'Locality': 'ÉVORA',
'OfficeType': 'HeadOffice',
'FoundIn': None,
'Score': 231.72766,
'PageUrl': '/pt/pesquisa/empresa/?Duns=453060832'}]}
I'm not being able to capture what is really happening using the XMLHTTP Browser request, that seems to be the below steps:
navigate to https://www.informadb.pt/pt/pesquisa/?search=500004064
Webpage generates additional traffic
Amongst that additional traffic is an API POST XHR request which
returns search results as JSON. That request goes to
https://www.informadb.pt/Umbraco/Api/Search/Companies and includes
the 500004064 identifier amongst the arguments within the post body
Based on the API results the browser ends up at the following URI
https://www.informadb.pt/pt/pesquisa/empresa/?Duns=453060832
Can someone help me please, I have to do it using VBA.
Thanks in advance.
A small example how to POST data to your website using VBA, and how to use bare-bones string processing to extract data from the result, as outlined in my comments above.
Function GetVatId(dunsNumber As String) As String
With New MSXML2.XMLHTTP60
.open "POST", "https://www.informadb.pt/Umbraco/Api/Search/Companies", False
.setRequestHeader "Content-Type", "application/json"
.send "{""Page"":0,""PageSize"":5,""SearchTerm"":""" & dunsNumber & """,""Filters"":[{""Key"":""districtFilter"",""Name"":""Distrito"",""Values"":[]},{""Key"":""legalFormFilter"",""Name"":""Forma Jurídica"",""Values"":[]}],""Culture"":""pt""}"
If .status = 200 Then
MsgBox "Response: " & .responseText, vbInformation
GetVatId = Mid(.responseText, InStr(.responseText, """Vat"":""") + 7, 9)
Else
MsgBox "Repsonse status " & .status, vbExclamation
End If
End With
End Function
Usage:
Dim vatId As String
vatId = GetVatId("453060832") ' => "500004064"
For a more robust solution, you should use a JSON parser and -serializer, something like https://github.com/VBA-tools/VBA-JSON.

Web Scraping using VBA and MSXML2.XMLHTTP library

I'm trying to scrap data from a website using MSXML2.XMLHTTP object on VBA environment (Excel) and I cannot figure out how to solve this problem! The website is the following:
http://www.detran.ms.gov.br/consulta-de-debitos/
You guys can use the following test data to fill the form:
Placa: oon5868
Renavam: 1021783231
I want to retrieve data like "chassi", with the data above that would be " 9BD374121F5068077".
I do not have problems parsing the html document, the difficult is actually getting the information as response! Code below:
Sub SearchVehicle()
Dim strPlaca As String
Dim strRenavam As String
strPlaca = "oon5868"
strRenavam = "01021783231"
Dim oXmlPage As MSXML2.XMLHTTP60
Dim strUrl As String
Dim strPostData As String
Set oXmlPage = New MSXML2.XMLHTTP60
strUrl = "http://www2.detran.ms.gov.br/detranet/nsite/veiculo/veiculos/retornooooveiculos.asp"
strPostData = "placa=" & strPlaca & "&renavam=" & strRenavam
oXmlPage.Open "POST", strUrl, False
oXmlPage.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oXmlPage.send strPostData
Debug.Print oXmlPage.responseText
End Sub
The strURL used in the POST method ".../retornooooveiculos.asp" is the one google developer tools and fiddler showed me that was the correct address the website was posting the payload.
When manually accessed, the website retrieve the correct information, but running my code I always get the following response on the .responseText:
<html>Acesse: <b><a href='http://www.detran.ms.gov.br target='_parent'>www.detran.ms.gov.br</a></b></html>
HELP PLEASE, I'm getting crazy trying to solve this puzzle! Why do I get redirected like this?
I need the "CHASSI" information and can't find the correct http Request to do this!
Try the below approach. It should fetch you the content you are after. The thing is you need to supply the Cookie copied from your Request Headers fields in order for your script to work which you can find using devtools.
Sub SearchVehicle()
Const URL As String = "http://www2.detran.ms.gov.br/detranet/nsite/veiculo/veiculos/retornooooveiculos.asp"
Dim HTTP As New ServerXMLHTTP60, HTML As New HTMLDocument
Dim elem As Object, splaca$, srenavam$, qsp$
splaca = "oon5868"
srenavam = "01021783231"
qsp = "placa=" & splaca & "&renavam=" & srenavam
With HTTP
.Open "POST", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "Cookie", "ISAWPLB{07D08995-E67C-4F44-91A1-F6A16337ECD6}={286E0BB1-C5F9-4439-A2CE-A7BE8C3955E0}; ASPSESSIONIDSCSDSCTB=AGDPOBEAAPJLLMKKIGPLBGMJ; 69137927=967930978"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send qsp
HTML.body.innerHTML = .responseText
End With
For Each elem In HTML.getElementsByTagName("b")
If InStr(elem.innerText, "Chassi:") > 0 Then MsgBox elem.ParentNode.NextSibling.innerText: Exit For
Next elem
End Sub
Once again: fill in the Cookie field by collecting it using your devtools (from Request Headers section), if for some reason my provided Cookie doesn't work for you. Thanks.
Output I'm getting:
9BD374121F5068077

Rubbish in "GET" response from RallyDev API

I have an function in Excel:
Function getState(Defects As Object) As String
Dim str As String
Dim res As String
Dim was As Boolean
Dim sURL As String
Dim oRequest As Object
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
was = False
For Each defect In Defects
If was = False Then
str = "(FormattedID = """ & defect & """)"
res = str
was = True
Else
res = res & " OR " & str
End If
Next defect
sURL = "https://rally1.rallydev.com/slm/webservice/v2.0/defect?query=(" & res & ")&fetch=FormattedID,State"
oRequest.Open "GET", sURL, True
oRequest.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
oRequest.Send
oRequest.WaitForResponse
' Set Defects = oRequest.ResponseText
Debug.Print (oRequest.ResponseText)
End Function
Unfortunately, i get rubbish instead of json in response like:
? i?ANA0E?=A(utU
¤RoP°irC°%'.o$%·CI{OOYO????uApeaBRM?Zb?u?OWo?"{oSCy5?(}e??e?qBA"qnu~E·Uu?|?aRbE?a>anµ?c?9P=?A[­Oul?0i O {PZS?Af~???^??k??R˜?|©?#iEoPNO|?¦'y?vO^Ol? ]?g?#?AjAa?\aC¤y %©e»]"IHog??#:?· (??"¶E9yog?Az?7bw?/#?eWp^u?ZU?u??3?q?A)cy7µe?E
Could you please take a look at it and provide an solution how it can be fixed?
Thank you in advance!
Larry's answer is correct.
As an aside, if you need to pull data from Rally into Excel, your best bet is the Rally Add-in for Excel:
https://help.rallydev.com/rally-add-excel
Since you mentioned VBA, you may be working to build some automation in Excel, which the Excel add-in doesn't support. There is an alpha-level Rally Rest Toolkit for VBA. It handles the authentication and REST serialization/de-serialization for you, so it could ease some of your coding effort.
It is unofficial and not supported by Rally, but could be worth trying. Since it is unsupported though, Rally can't help you out if you run into issues. You'd have to refactor your own code against the VBA toolkit to pull the data you want:
https://github.com/markwilliams970/RallyRestToolkitForVBA
The response is compressed. Either try setting a request header for Accept-Encoding: identity or decompress the response.

How to browse through box.com folders to select a file and download the selected file

I need a excel macro (vba) to select a file from box.com by iterating though existing folders and at the same time I need to upload the file from my machine to box.com folder using excel macro. I am searching for a long time on net. But no use. Please help or try to give some ideas how to achieve this.
Thanks in advance.
-Edit
I am using the below code for getting authentication token. But I am getting an error message at the place of .send(url). Error message is "The server name or address could not be resolved".
Function getAuthToken()
Dim WinHttpReq As WinHttp.WinHttpRequest
Dim api_key As String
api_key = "{api_key}"
Set WinHttpReq = New WinHttp.WinHttpRequest
strUrl = "https://www.box.net/api/1.0/rest?action=get_ticket&api_key=" & api_key
WinHttpReq.Open Method:="GET", url:=strUrl, async:=False
WinHttpReq.Send
getTicket = WinHttpReq.responseText
Debug.Print getTicket
End Function
Not being a vba expert, I suspect that you'll get more answers if you tag your question with a vba tag. However, some quick scanning around shows that vba can call REST apis by doing something like this:
Dim MyURL as String
MyURL = "http://api.box.com/2.0/folders/0.xml"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
With objHTTP
.Open "GET", MyURL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Authorization", "BoxAuth api_key=<your api key>&auth_token=<your auth token>
.send (MyURL)
End With
I'll defer to a real VBA expert, but something roughly along these lines should work.
Yeah, this is frustrating. I tried code like Peter's using both WinHttp.WinHttpRequest.5.1 and MSXML2.ServerXMLHTTP and with both I just get a zero-length string back. No error message or anything.
I installed cURL and tested the URL. It works fine there. The script below also works fine with a generic JSON web service, like jsonplaceholder.typicode.com.
All this makes me think that Box.com is receiving the message, detecting it is coming from a non-approved source, and returning nothing . . . probably for security reasons.
Option Explicit
Const URL As String = "https://api.box.com/2.0/folders/0 -H ""Authorization: Bearer MyToken"""
'Const URL As String = "https://jsonplaceholder.typicode.com/posts/1"
Sub Test()
Dim winHTTP As Object
' Set winHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
Set winHTTP = CreateObject("MSXML2.ServerXMLHTTP")
winHTTP.Open "GET", URL
winHTTP.setRequestHeader "Content-Type", "application/json"
winHTTP.send
Debug.Print winHTTP.ResponseText
If Len(winHTTP.ResponseText) = 0 Then
MsgBox "blank string returned"
Else
Dim objResponse As Object
Set objResponse = JsonConverter.ParseJson(winHTTP.ResponseText) 'Converter from Tim Hall - https://github.com/VBA-tools/VBA-JSON
End If
End Sub