I'm trying to communicate with Google Distance API via VBA in 64bit Excel 365, but having trouble with special character input in street address data. Other threads having similar issues with other HTTP requests, though with output and I struggle to relate.
Sub Check_routes()
Dim objRequest, Json As Object
Dim apiKey, apiURL, myOrigin, myDest As String
Set objRequest = CreateObject("MSXML2.XMLHTTP")
myOrigin = "Tähetorni+1+Tallinn"
myDest = "Sääse+2+Tallinn"
apiURL = "https://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins=" & myOrigin & "&destinations=" & myDest & "&mode=driving&key=" & apiKey
objRequest.Open "GET", apiURL, False
objRequest.send
...
Set objRequest = Nothing
End Sub
I'm getting an error response in JSON back stating Invalid 'origins' parameter. The problem is special character ä in origin & destination. Replacing this with a fixes it, but that's not a reliable solution. Is my problem string not being UTF-8 as Google stipulates?
https://developers.google.com/maps/documentation/distance-matrix/web-service-best-practices#BuildingURLs
Power Query in Excel environment is also perfectly capable in communicating with Google Distance API and has no problem handling special characters - and is a more convenient tool on top of that, however annoyingly generates duplicate requests which is less than ideal with a paid API such as Google Distance. That's the lone reason for going with VBA here.
Is this a MSXML2.XMLHTTP object problem which cannot handle my input string as is?
I suggest you change these two lines in your code:
myOrigin = WorksheetFunction.EncodeURL("Tähetorni 1 Tallinn")
myDest = WorksheetFunction.EncodeURL("Sääse 2 Tallinn")
Your code returns a valid string with those changes (also note I replaced the + with <space> as the function will take care of encoding that also).
By the way, you need to specify data type for each element in a declaration string. They will NOT take the data type of the last element. Rather they will be of type Variant when not specified.
So change these lines also:
Dim objRequest as Object, Json As Object
Dim apiKey as String, apiURL as String, myOrigin as String, myDest As String
Related
I am stuck with this. I am trying to learn how to use xmlhttprequest with VBA. My intention is to access the following url: "https://micuil.net/".
Once there, I can send values to the following fields, as seen in the image:
image1
After pressing the button, the page displays the following information with the data I want to extract:
image2 (return value)
I am able to complete what you see in image 1 by code, but I don't know how to get the result (image 2). Any help please?
Function CuitEstimado2(sDni As Variant, sSexo As String) As String
Set oDoc = New HTMLDocument
Set oHTTP = New XMLHTTP60
sSexo = IIf(sSexo = "f", "Mujeres", "Varones")
sUrl = "https://micuil.net/"
oHTTP.Open "GET", sUrl, False
oHTTP.send
sRespuesta = oHTTP.responseText
oDoc.body.innerHTML = sRespuesta
oDoc.getElementById("dni").Value = sDni
oDoc.getElementsByName("sexo")(0).setAttribute("checked") = True
oDoc.getElementById("btn").parentElement.Click
End Function
Without having done heavy research for the specific website you are using, it may still be possible that the result you are looking for can be found within the response text (assuming I am understanding your dilemma properly).
First, it is recommended to perform a loop through the innerHTML of each element contained in the HTMLDoc. During your loop, use the InStr function to locate the result code as a string. It is a good idea to store each element that contains that result code into a collection for easy access after the loop.
It does get a bit more complicated from here, because the innerHTML of the corresponding elements may differ when pasting them into Notepad vs. trying to utilize in the VBE. However, if you can identify any unique JS (or other language) characters that will consistently indicate the location of the result code for each request, you may be able to use the Mid function to return the desired result into a string variable.
I copied code to get stock data from hsbc derivatives. (https://www.youtube.com/watch?v=IOzHacoP-u4)
I changed the URL (to hsbc) and that I want to find the value based on the ID, not the class name.
I changed the ID name.
I get
"Run Time Error-91:
Object variable or With block variable not set".
Sub Get_Web_Data()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant
' Website to go to.
website = "https://www.hsbc-zertifikate.de/home/details#!/isin:DE000TR8S293"
' Create the object that will make the webpage request.
Set request = CreateObject("MSXML2.XMLHTTP")
' Where to go and how to go there - probably don't need to change this.
request.Open "GET", website, False
' Get fresh data.
'request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
' Send the request for the webpage.
request.send
' Get the webpage response data into a variable.
response = StrConv(request.responseBody, vbUnicode)
' Put the webpage into an html object to make data references easier.
html.body.innerHTML = response
' Get the price from the specified element on the page.
price = html.getElementById("kursdaten20").innerText
' Output the price into a message box.
MsgBox price
End Sub
You are searching for element id kursdaten20 that does not exist on the page.
html.getElementById("kursdaten20") returns Nothing and you are accessing the innerText property with Nothing/Null reference.
When searching for element, you could add a check if the element exists:
'query the document
Set element = html.getElementById("kursdaten20")
If Not element Is Nothing Then
' Get the price from the specified element on the page.
price = element.innerText
' Output the price into a message box.
MsgBox price
Else
' no price
MsgBox "no price"
End If
I'm afraid it's more complicated than what you expected it to be.
I will assume that the info you're after is this:
Geldkurs (1 Stuck)4,01 EUR
Briefkurs (1 Stuck)4,11 EUR
These fields are not static. They are dynamically updated (I guess whenever a transaction is made) by scripts. That's why you will not find their ID's in the source code of the HTML page.
There is however a way to get the info you need by replicating the HTTP request that is being sent to the server whenever these fields are updated.
To find this request and its parameters you need to inspect the network traffic, when you load the page, using your browser's developer tools.
This request returns a (quite poorly structured IMHO) JSON response containing another JSON (!!) which contains the info you want, in HTML format(!!). Here's how the second JSON looks like:
To make things even worse, the names that you can see under state, change with each request you send.
So, firstly you need to parse the json response. Then you need to parse the json within the initial json response to get your hands on the HTML code. Then, using an HTML document object, you can easily get access to the HTML table, containing the desired information.
Here's the way to do it:
Option Explicit
Sub hsbc()
Dim req As New WinHttpRequest
Dim doc As New HTMLDocument
Dim table As HTMLTable
Dim cell As HTMLTableCell
Dim parsedJSON As Object
Dim key As Variant
Dim htmlCode As String
Dim url As String, reqBody As String, resp As String
url = "https://www.hsbc-zertifikate.de/web-htde-tip-zertifikate-main/?components=YW1wZWw6UnRQdWxsQ29tcG9uZW50KCdhbmltQ3NzLGMtaGlnaGxpZ2h0LXVwLGMtaGlnaGxpZ2h0LWRvd24sYy1oaWdobGlnaHQtY2hhbmdlZCcpO3NlYXJjaGhpbnRfbW9iaWxlOlNlYXJjaEhpbnRNb2JpbGVDb21wb25lbnQoJ3VsU2VhcmNoU21hbGwvc2VhcmNoSW5wdXRNb2JpbGUnKTtzZWFyY2hoaW50OlNlYXJjaEhpbnRDb21wb25lbnQoJ3VsU2VhcmNoRnVsbC9zZWFyY2gtaGVhZGVyJyk7aXNpbjpSZXNwb25zaXZlU25hcHNob3RDb21wb25lbnQoJ2ZhbHNlJyk%3D&pagepath=https%3A%2F%2Fwww.hsbc-zertifikate.de%2Fhome%2Fdetails%23!%2Fisin%3ADE000TR8S293&magnoliaSessionId=B22F70D76986AB6BACDF110E4E7A724C.public7a&v-1566551332455"
reqBody = "v-browserDetails=1&theme=hsbc&v-appId=myApp&v-sh=1080&v-sw=1920&v-cw=1920&v-ch=550&v-curdate=1566551332455&v-tzo=-180&v-dstd=60&v-rtzo=-120&v-dston=true&v-vw=50&v-vh=50&v-loc=https%3A%2F%2Fwww.hsbc-zertifikate.de%2Fhome%2Fdetails%23!%2Fisin%3ADE000TR8S293&v-wn=myApp-0.5436432044490654"
With req
.Open "POST", url, False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.send reqBody
resp = .responseText
End With
Set parsedJSON = JsonConverter.ParseJson(resp)
Set parsedJSON = JsonConverter.ParseJson(parsedJSON("uidl"))
For Each key In parsedJSON("state").Keys
If parsedJSON("state")(key)("contentMode") = "HTML" Then
htmlCode = htmlCode & parsedJSON("state")(key)("text")
End If
Next key
doc.body.innerHTML = htmlCode
Set table = doc.getElementsByTagName("table")(0)
Debug.Print table.Rows(2).innerText
Debug.Print table.Rows(3).innerText
End Sub
For demonstration purposes the result will be printed in your immediate window.
You will need to add the following references to your project (VBE>Tools>References):
Microsoft WinHTTP Services version 5.1
Microsoft HTML Objects Library
Microsoft Scripting Runtime
You will also need to add this JSON parser to your project. Follow the installation instructions in the link and you should be set to go.
First of all tank you for all help here! nice place to be and learn a lot!
My Problem: I want to return Geo coordinates from an address. Like here: https://www.myengineeringworld.net/2014/06/geocoding-using-vba-google-api.html
I created an API Key and this code is working fine! But we have a Firewall and the Firewall is blocking Excel communication to the google maps server on the "request.send" point (and i couldn't find an IP Range or something that you can put on the whitelist), is there a chance to get the XML code by your browser? Because i can use the link from "Request.Open "GET" and i see the XML content in the Internet Explorer.
Is there any other way than request.send
Thank you guys!
Code:
Function GetCoordinates(Address As String) As String
'-----------------------------------------------------------------------------------------------------
'This function returns the latitude and longitude of a given address using the Google Geocoding API.
'The function uses the "simplest" form of Google Geocoding API (sending only the address parameter),
'so, optional parameters such as bounds, language, region and components are NOT used.
'In case of multiple results (for example two cities sharing the same name), the function
'returns the FIRST OCCURRENCE, so be careful in the input address (tip: use the city name and the
'postal code if they are available).
'NOTE: As Google points out, the use of the Google Geocoding API is subject to a limit of 40,000
'requests per month, so be careful not to exceed this limit. For more info check:
'https://cloud.google.com/maps-platform/pricing/sheet
'In order to use this function you must enable the XML, v3.0 library from VBA editor:
'Go to Tools -> References -> check the Microsoft XML, v3.0.
'If you don't have the v3.0 use any other version of it (e.g. v6.0).
'2018 Update: In order to use this function you will now need a valid API key.
'Check the next link that guides you on how to acquire a free API key:
'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
'2018 Update 2 (July): The EncodeURL function was added to avoid problems with special characters.
'This is a common problem with addresses that are from Greece, Serbia, Germany and other countries.
'Written By: Christos Samaras
'Date: 12/06/2014
'Last Updated: 09/08/2018
'E-mail: xristos.samaras#gmail.com
'Site: https://www.myengineeringworld.net
'-----------------------------------------------------------------------------------------------------
'Declaring the necessary variables.
'The first 2 variables using 30 at the end, corresponding to the "Microsoft XML, v3.0" library
'in VBA (msxml3.dll). If you use any other version of it (e.g. v6.0), then declare these variables
'as XMLHTTP60 and DOMDocument60 respectively.
Dim ApiKey As String
Dim Request As New XMLHTTP30
Dim Results As New DOMDocument30
Dim StatusNode As IXMLDOMNode
Dim LatitudeNode As IXMLDOMNode
Dim LongitudeNode As IXMLDOMNode
'Set your API key in this variable. Check this link for more info:
'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
ApiKey = "Your API Key goes here!"
'Check that an API key has been provided.
If ApiKey = vbNullString Or ApiKey = "Your API Key goes here!" Then
GetCoordinates = "Invalid API Key"
Exit Function
End If
'Generic error handling.
On Error GoTo errorHandler
'Create the request based on Google Geocoding API. Parameters (from Google page):
'- Address: The address that you want to geocode.
'Note: The EncodeURL function was added to allow users from Greece, Poland, Germany, France and other countries
'geocode address from their home countries without a problem. The particular function (EncodeURL),
'returns a URL-encoded string without the special characters.
Request.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & Application.EncodeURL(Address) & "&key=" & ApiKey, False
'Send the request to the Google server.
Request.send
'Read the results from the request.
Results.LoadXML Request.responseText
'Get the status node value.
Set StatusNode = Results.SelectSingleNode("//status")
'Based on the status node result, proceed accordingly.
Select Case UCase(StatusNode.Text)
Case "OK" 'The API request was successful. At least one geocode was returned.
'Get the latitude and longitude node values of the first geocode.
Set LatitudeNode = Results.SelectSingleNode("//result/geometry/location/lat")
Set LongitudeNode = Results.SelectSingleNode("//result/geometry/location/lng")
'Return the coordinates as a string (latitude, longitude).
GetCoordinates = LatitudeNode.Text & ", " & LongitudeNode.Text
Case "ZERO_RESULTS" 'The geocode was successful but returned no results.
GetCoordinates = "The address probably not exists"
Case "OVER_QUERY_LIMIT" 'The requestor has exceeded the limit of 2500 request/day.
GetCoordinates = "Requestor has exceeded the server limit"
Case "REQUEST_DENIED" 'The API did not complete the request.
GetCoordinates = "Server denied the request"
Case "INVALID_REQUEST" 'The API request is empty or is malformed.
GetCoordinates = "Request was empty or malformed"
Case "UNKNOWN_ERROR" 'Indicates that the request could not be processed due to a server error.
GetCoordinates = "Unknown error"
Case Else 'Just in case...
GetCoordinates = "Error"
End Select
End Function '
You can try to detect the proxy settings and add these to the XMLHTTP request.
See this link for a good starting point (too much code to paste here): http://www.tech-archive.net/Archive/VB/microsoft.public.vb.winapi.networks/2004-11/0005.html
I have an app in classic asp and want to rewrite URLs.
From: go.asp?t=5&group=XXXXXX&sub=YYYYY to: cat/XXXXXXXXXXXXX/YYYYYYYYYY
and from: go.asp?t=15&number=XXXXXXXX to lets say: S/XXXXXXXX
and so on, I will have more rules just with different T variable values.
How can I write rewrite rules and proper redirect based on specific T value?
Seems like a viable question to me. In Classic ASP, for a get, the querystring values are available in Request.QueryString("varname"). So you could do
dim t, sResult, oRequest
set oRequest = Request.QueryString ' convenience assignment
t = oRequest("t")
t = cLng(t) ' force t from string into a number
select case t
case 1
dim sGroup, sSub ' sub is a keyword to VBScript
sGroup=oRequest("group")
sSub=oRequest("sub")
sResult = "cat/" & sGroup & "/" & sSub
case 15
dim sNumber
sNumber=oRequest("number")
sResult = "S/" & sNumber
end select
response.redirect sResult
The code is untested but should lead you in the right direction. You can extend the cases and the URL param harvesting as required by your use case.
If it was me and there were a large number of cases I would probably set up some kind of metadata to describe what to harvest per value of 't' then have one function to handle the job based on that.
There 'are' more sophisticated IIS-level URL redirection features but they introduce other dependencies. If all you need to do is modify the incoming URL then this is a cheap and cheerful way forward.
I am a self-taught, amateur programmer, and I am new to this forum. Please bear with me.
About two years ago, I wrote a simple Excel vba program to login in to a website and grab a customer statement in the form of a .csv file. My program utilizes GET and POST requests. This program worked perfectly (for my needs) until about three weeks ago, when it unfortunately broke on me. The program could not get through the initial GET request. Specifically, it would break on the getReq.send line.
I came across this post:
Login into website using MSXML2.XMLHTTP instead of InternetExplorer.Application with VBA
Here, I learned that you can use "Msxml2.XMLHTTP.6.0" instead of "Msxml2.ServerXMLHTTP.6.0". I modified my code accordingly, eliminating the need to parse cookies after the Get request, and it worked! But I have no idea. Even though I got it to work, I do not feel like I have learned much in the process.
Some information to note:
My original program broke on my work computer (WindowsXP).
Figuring that it may be an XP issue, and in the market for a new machine anyway, I updated to a new computer running Windows7. The program still did not work, though I received a different error message.
I ran my code on a Windows10 computer and it worked fine.
I use identical code to connect to various other websites and it works fine, regardless of what operating system.
So, my specific questions:
Why might the code work with Msxml2.XMLHTTP.6.0 but not Msxml2.ServerXMLHTTP.6.0?
And why might the code have broken in the first place?
Why would the code work on one particular website, but no another?
Any insight would be greatly appreciated. I have attached my code (with login info X'd out).
Sub RCGInquiry()
Dim postReq, getReq, cookies
Dim p0 As Integer, p1 As Integer, temp As String
Dim result As String, respHead As String
Set getReq = CreateObject("Msxml2.ServerXMLHTTP.6.0")
'Set getReq = CreateObject("Msxml2.XMLHTTP.6.0")
' Visit homepage so we can find the cookies
getReq.Open "GET", "https://www.rcginquiry.com/sfs/Entry", False
getReq.send
respHead = getReq.getAllResponseHeaders
Debug.Print respHead
' Need to parse the cookie from Respone Headers
cookies = ""
p0 = 1
Do While InStr(p0, respHead, "Set-Cookie:") > 0
p0 = InStr(p0, respHead, "Set-Cookie:") + 11
p1 = InStr(p0, respHead, Chr(10))
temp = Trim(Mid(respHead, p0, p1 - p0))
cookies = cookies & temp & "; "
Loop
cookies = Left(cookies, Len(cookies) - 2)
' Debug.Print cookies
' Login
Set postReq = CreateObject("Msxml2.ServerXMLHTTP.6.0")
'Set postReq = CreateObject("Msxml2.XMLHTTP.6.0")
postReq.Open "POST", "https://www.rcginquiry.com/sfs/Entry", False
postReq.setRequestHeader "Cookie", cookies
postReq.setRequestHeader "Content-type", "application/x-www-form-urlencoded" 'send appropriate Headers
postReq.send "Usrid=XXXX&Psswd=XXXX" ' send login info
'-------------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FSO As Object
Dim myFile As Object
Dim path As String
Dim y As Integer
curDate = Format(Date, "mm_dd_yy")
' Download CSV
postReq.Open "POST", "https://www.rcginquiry.com/sfs/Downloads/tmp.csv?filetype=POS&format=MFA20&heading=true&allaccts=true&junk=tmp.csv", False
postReq.setRequestHeader "Cookie", cookies 'must resend cookies so it knows i am logged in
postReq.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
postReq.send "filetype=POS&format=MFA20&heading=true&allaccts=true&junk=temp.csv" 'url query parameters
' Writes responseText to a .csv file
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFile = FSO.createtextfile("C:\Users\Adam\Desktop\POSITION\" & curDate & ".csv", True)
myFile.write (postReq.responseText)
myFile.Close
Set FSO = Nothing
Set myFile = Nothing
End Sub
This blog post says that ServerXLMHTTP will not work through a proxy on the client, but XMLHTTP will. In Excel VBA I was using ServerXLMHTTP.6.0, and it was failing for some clients inside corporate networks, whereas XMLHTTP worked.
Welcome to VBA and StackOverflow. Your notes are thorough and so the only thing I can suggest is that you check your proxy settings.
https://support.microsoft.com/en-us/help/289481/you-may-need-to-run-the-proxycfg-tool-for-serverxmlhttp-to-work
That link was buried in this link
https://support.microsoft.com/en-us/help/290761/frequently-asked-questions-about-serverxmlhttp
which you were referred to by ComIntern